├── .gitignore ├── Setup.hs ├── ChangeLog.md ├── src ├── Stream │ ├── Core │ │ └── Internal.hs │ └── Core.hs └── Stream.hs ├── README.md ├── LICENSE ├── test └── Spec.hs ├── stack.yaml ├── stream.cabal ├── bench └── stream-bench.hs └── .travis.yml /.gitignore: -------------------------------------------------------------------------------- 1 | *.swp 2 | .stack-work/ 3 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /ChangeLog.md: -------------------------------------------------------------------------------- 1 | ## 0.1.0.0 2 | 3 | * Initial pre-release version, not at all ready for usage! 4 | -------------------------------------------------------------------------------- /src/Stream/Core/Internal.hs: -------------------------------------------------------------------------------- 1 | -- FIXME move to stream-core library 2 | {-# LANGUAGE RankNTypes #-} 3 | {-# LANGUAGE GADTs #-} 4 | module Stream.Core.Internal where 5 | 6 | data Step s o r 7 | = Done r 8 | | Yield s o 9 | | Skip s 10 | 11 | data StreamT o m r = forall s. StreamT 12 | (s -> m (Step s o r)) 13 | (forall b. (s -> m b) -> m b) 14 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## stream 2 | 3 | [![Build Status](https://travis-ci.org/fpco/stream.svg?branch=master)](https://travis-ci.org/fpco/stream) 4 | 5 | *NOTE* This library is very much in prerelease state. If you see this released 6 | anywhere, it's just available for easier sharing with others. Please do _not_ 7 | start using it yet. 8 | 9 | Streaming data library built around making stream fusion a first-class concept. 10 | Focus is on high performance and usability. 11 | 12 | Unlike more commonly used streaming libraries (like conduit, enumerator, or 13 | pipes), this library is _not_ coroutine based. 14 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016 FP Complete, https://www.fpcomplete.com/ 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files (the 5 | "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject to 9 | the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be 12 | included in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | import Test.Hspec 2 | import Test.Hspec.QuickCheck 3 | import Stream 4 | import qualified Data.ByteString as S 5 | import qualified Data.ByteString.Char8 as S8 6 | import System.IO.Temp 7 | import System.IO (hClose) 8 | 9 | main :: IO () 10 | main = hspec $ do 11 | it "enum/map/sum sanity" $ 12 | runIdentity (sumS $ mapS (+ 1) $ enumFromToS 1 (1000 :: Int)) 13 | `shouldBe` sum (map (+ 1) [1..1000]) 14 | prop "file copy" $ \octets -> 15 | withSystemTempFile "src" $ \srcFP srcH -> 16 | withSystemTempFile "dst" $ \dstFP dstH -> do 17 | let bsOrig = S.pack octets 18 | S.hPut srcH bsOrig 19 | hClose srcH 20 | hClose dstH 21 | writeFileS dstFP $ readFileS srcFP 22 | actual <- S.readFile dstFP 23 | actual `shouldBe` bsOrig 24 | prop "lines" $ pending {- \octetss -> 25 | let ls = map S.pack octetss 26 | bs = S8.unlines ls 27 | src = yieldS [bs] 28 | sink = linesAsciiS (const go) () 29 | go = error "go" 30 | res = runIdentity $ sinkListS $ sink src 31 | in res `shouldBe` S8.lines bs 32 | -} 33 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by stack init 2 | # For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration/ 3 | 4 | # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) 5 | resolver: lts-5.10 6 | 7 | # Local packages, usually specified by relative directory name 8 | packages: 9 | - '.' 10 | # Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3) 11 | extra-deps: [] 12 | 13 | # Override default flag values for local packages and extra-deps 14 | flags: {} 15 | 16 | # Extra package databases containing global packages 17 | extra-package-dbs: [] 18 | 19 | # Control whether we use the GHC we find on the path 20 | # system-ghc: true 21 | 22 | # Require a specific version of stack, using version ranges 23 | # require-stack-version: -any # Default 24 | # require-stack-version: >= 1.0.0 25 | 26 | # Override the architecture used by stack, especially useful on Windows 27 | # arch: i386 28 | # arch: x86_64 29 | 30 | # Extra directories used by stack for building 31 | # extra-include-dirs: [/path/to/dir] 32 | # extra-lib-dirs: [/path/to/dir] 33 | 34 | # Allow a newer minor version of GHC than the snapshot specifies 35 | # compiler-check: newer-minor 36 | -------------------------------------------------------------------------------- /stream.cabal: -------------------------------------------------------------------------------- 1 | name: stream 2 | version: 0.1.0.0 3 | synopsis: Initial project template from stack 4 | description: Please see README.md 5 | homepage: https://github.com/githubuser/stream#readme 6 | license: MIT 7 | license-file: LICENSE 8 | author: Michael Snoyman 9 | maintainer: michael@fpcomplete.com 10 | copyright: 2016 FP Complete 11 | category: Data 12 | build-type: Simple 13 | extra-source-files: README.md ChangeLog.md 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | exposed-modules: Stream 19 | Stream.Core 20 | Stream.Core.Internal 21 | build-depends: base >= 4.8 && < 5 22 | , bytestring 23 | , exceptions 24 | , mtl 25 | , streaming-commons 26 | , transformers 27 | default-language: Haskell2010 28 | 29 | test-suite stream-test 30 | type: exitcode-stdio-1.0 31 | hs-source-dirs: test 32 | main-is: Spec.hs 33 | build-depends: base 34 | , bytestring 35 | , hspec 36 | , stream 37 | , temporary 38 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 39 | default-language: Haskell2010 40 | 41 | benchmark stream-bench 42 | type: exitcode-stdio-1.0 43 | hs-source-dirs: bench 44 | main-is: stream-bench.hs 45 | build-depends: base 46 | , bytestring 47 | , criterion 48 | , ghc-prim 49 | , stream 50 | , temporary 51 | , vector 52 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2 53 | default-language: Haskell2010 54 | 55 | source-repository head 56 | type: git 57 | location: https://github.com/githubuser/stream 58 | -------------------------------------------------------------------------------- /src/Stream/Core.hs: -------------------------------------------------------------------------------- 1 | -- FIXME move to stream-core library 2 | {-# LANGUAGE RankNTypes #-} 3 | module Stream.Core 4 | ( -- * Types 5 | StreamT 6 | , Step (..) 7 | -- * Helpers 8 | , mapStep 9 | , runStreamT 10 | -- * Smart constructros 11 | -- ** Source 12 | , makeSource 13 | , makeSourceWith 14 | -- ** Transformer 15 | , makeTransformer 16 | , makeTransformer' 17 | -- ** Sink 18 | , makeSink 19 | ) where 20 | 21 | import Stream.Core.Internal 22 | 23 | mapStep :: (i -> o) -> Step s i r -> Step s o r 24 | mapStep _ (Done r) = Done r 25 | mapStep f (Yield s i) = Yield s (f i) 26 | mapStep _ (Skip s) = Skip s 27 | {-# INLINE mapStep #-} 28 | 29 | runStreamT :: Monad m => StreamT o m r -> m r 30 | runStreamT = 31 | makeSink go 32 | where 33 | go s0 f = 34 | loop s0 35 | where 36 | loop s = do 37 | step <- f s 38 | case step of 39 | Done r -> pure r 40 | Yield s' _ -> loop s' 41 | Skip s' -> loop s' 42 | {-# INLINE runStreamT #-} 43 | 44 | makeSource :: state 45 | -> (state -> m (Step state o r)) 46 | -> StreamT o m r 47 | makeSource state f = StreamT f ($ state) 48 | {-# INLINE makeSource #-} 49 | 50 | makeSourceWith :: (forall b. (state -> m b) -> m b) 51 | -> (state -> m (Step state o r)) 52 | -> StreamT o m r 53 | makeSourceWith withState f = StreamT f withState 54 | {-# INLINE makeSourceWith #-} 55 | 56 | makeTransformer :: myState 57 | -> (forall upState. 58 | myState 59 | -> upState 60 | -> (upState -> m (Step upState i upR)) 61 | -> m (Step (myState, upState) o myR)) 62 | -> StreamT i m upR 63 | -> StreamT o m myR 64 | makeTransformer myState f (StreamT g withUpState) = 65 | StreamT (\(myState, upState) -> f myState upState g) withState 66 | where 67 | withState inner = withUpState $ \upState -> inner (myState, upState) 68 | 69 | makeTransformer' :: (forall upState. 70 | upState 71 | -> (upState -> m (Step upState i upR)) 72 | -> m (Step upState o myR)) 73 | -> StreamT i m upR 74 | -> StreamT o m myR 75 | makeTransformer' f (StreamT g withState) = 76 | StreamT (\s -> f s g) withState 77 | {-# INLINE makeTransformer' #-} 78 | 79 | makeSink :: (forall state. state -> (state -> m (Step state i upR)) -> m myR) 80 | -> StreamT i m upR 81 | -> m myR 82 | makeSink f (StreamT g withState) = withState $ \state -> f state g 83 | {-# INLINE makeSink #-} 84 | -------------------------------------------------------------------------------- /bench/stream-bench.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE MagicHash #-} 3 | import Criterion.Main 4 | import Stream 5 | import qualified Data.Vector as VB 6 | import qualified Data.Vector.Unboxed as VU 7 | import GHC.Prim 8 | import GHC.Types 9 | import System.IO (hClose) 10 | import System.IO.Temp (withSystemTempFile) 11 | import qualified Data.ByteString as S 12 | import qualified Data.ByteString.Lazy as L 13 | import Data.ByteString.Lazy.Internal (defaultChunkSize) 14 | import qualified System.IO as IO 15 | 16 | withTempFP :: String -> (FilePath -> IO a) -> IO a 17 | withTempFP str inner = withSystemTempFile str $ \fp h -> do 18 | hClose h 19 | inner fp 20 | 21 | main :: IO () 22 | main = withTempFP "src" $ \srcFP -> withTempFP "dst" $ \dstFP -> do 23 | L.writeFile dstFP $ L.fromChunks $ replicate 10000 $ S.replicate 1000 65 24 | 25 | defaultMain 26 | [ let high = 1000000 :: Int 27 | go name f = bench name $ whnf f high 28 | {-# INLINE go #-} 29 | in bgroup "enum/map/sum" 30 | [ go "stream" $ runIdentity . sumS . mapS (+ 1) . enumFromToS 1 31 | , go "prim" $ \(I# high') -> 32 | let loop x total = 33 | case x +# 1# of 34 | y -> 35 | case total +# y of 36 | total' -> 37 | if isTrue# (x <=# high') 38 | then loop y total' 39 | else I# total' 40 | in loop 1# 0# 41 | , go "low level" $ \high' -> 42 | let loop !x !total 43 | | x <= high' = loop y total' 44 | | otherwise = total' 45 | where 46 | !y = x + 1 47 | !total' = total + y 48 | {-# INLINE loop #-} 49 | in loop 1 0 50 | , go "boxed vector" $ VB.sum . VB.map (+ 1) . VB.enumFromTo 1 51 | , go "unboxed vector" $ VU.sum . VU.map (+ 1) . VU.enumFromTo 1 52 | ] 53 | , bgroup "file copy" 54 | [ bench "stream" $ whnfIO $ writeFileS dstFP $ readFileS srcFP 55 | , bench "lazy I/O" $ whnfIO $ L.readFile srcFP >>= L.writeFile dstFP 56 | , bench "low level" $ whnfIO $ 57 | IO.withBinaryFile srcFP IO.ReadMode $ \src -> 58 | IO.withBinaryFile dstFP IO.WriteMode $ \dst -> 59 | let loop = do 60 | bs <- S.hGetSome src defaultChunkSize 61 | if S.null bs 62 | then return () 63 | else do 64 | S.hPut dst bs 65 | loop 66 | in loop 67 | ] 68 | ] 69 | -------------------------------------------------------------------------------- /src/Stream.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | module Stream 3 | ( -- * Types 4 | StreamT 5 | -- * Common 6 | , runStreamT 7 | 8 | -- * Sources 9 | -- ** Pure 10 | , enumFromToS 11 | , yieldS 12 | 13 | -- * Transformers 14 | -- ** Pure 15 | , mapS 16 | -- ** Monadic 17 | 18 | -- * Sinks 19 | -- ** Pure 20 | , foldlS 21 | , sumS 22 | , sinkListS 23 | -- ** Monadic 24 | , mapM_S 25 | 26 | -- * I/O 27 | , readFileS 28 | , writeFileS 29 | 30 | -- * Textual 31 | , linesAsciiS 32 | 33 | -- * Reexports 34 | , Identity (..) 35 | ) where 36 | 37 | import Stream.Core 38 | import Data.Functor.Identity (Identity (..)) 39 | import Data.Int 40 | import Data.Word 41 | import qualified Control.Monad.Catch as Catch 42 | import Control.Monad.IO.Class (MonadIO, liftIO) 43 | import qualified Data.ByteString as S 44 | import qualified System.IO as IO 45 | import qualified Data.Streaming.FileRead as FR 46 | import qualified Data.Foldable as F 47 | 48 | enumFromToS :: (Ord a, Enum a, Applicative m) 49 | => a 50 | -> a 51 | -> StreamT a m () 52 | enumFromToS start end = 53 | makeSource start go 54 | where 55 | go x 56 | | x <= end = 57 | let !y = succ x 58 | in pure (Yield y x) 59 | | otherwise = pure (Done ()) 60 | {-# INLINE [1] enumFromToS #-} 61 | 62 | enumFromToS_num 63 | :: (Ord a, Num a, Applicative m) 64 | => a 65 | -> a 66 | -> StreamT a m () 67 | enumFromToS_num start end = 68 | makeSource start go 69 | where 70 | go x 71 | | x <= end = 72 | let !y = x + 1 73 | in pure (Yield y x) 74 | | otherwise = pure (Done ()) 75 | {-# INLINE [0] enumFromToS_num #-} 76 | {-# RULES 77 | 78 | "enumFromToS" enumFromToS = 79 | enumFromToS_num :: Applicative m => Int -> Int -> StreamT Int m () 80 | 81 | "enumFromToS" enumFromToS = 82 | enumFromToS_num :: Applicative m => Int8 -> Int8 -> StreamT Int8 m () 83 | 84 | "enumFromToS" enumFromToS = 85 | enumFromToS_num :: Applicative m => Int16 -> Int16 -> StreamT Int16 m () 86 | 87 | "enumFromToS" enumFromToS = 88 | enumFromToS_num :: Applicative m => Int32 -> Int32 -> StreamT Int32 m () 89 | 90 | "enumFromToS" enumFromToS = 91 | enumFromToS_num :: Applicative m => Int64 -> Int64 -> StreamT Int64 m () 92 | 93 | "enumFromToS" enumFromToS = 94 | enumFromToS_num :: Applicative m => Word -> Word -> StreamT Word m () 95 | 96 | "enumFromToS" enumFromToS = 97 | enumFromToS_num :: Applicative m => Word8 -> Word8 -> StreamT Word8 m () 98 | 99 | "enumFromToS" enumFromToS = 100 | enumFromToS_num :: Applicative m => Word16 -> Word16 -> StreamT Word16 m () 101 | 102 | "enumFromToS" enumFromToS = 103 | enumFromToS_num :: Applicative m => Word32 -> Word32 -> StreamT Word32 m () 104 | 105 | "enumFromToS" enumFromToS = 106 | enumFromToS_num :: Applicative m => Word64 -> Word64 -> StreamT Word64 m () 107 | 108 | "enumFromToS" enumFromToS = 109 | enumFromToS_num :: Applicative m => Integer -> Integer -> StreamT Integer m () #-} 110 | 111 | yieldS :: (F.Foldable f, Applicative m) 112 | => f o 113 | -> StreamT o m () 114 | yieldS x = 115 | makeSource (F.toList x) go 116 | where 117 | go [] = pure (Done ()) 118 | go (y:ys) = pure (Yield ys y) 119 | {-# INLINE yieldS #-} 120 | 121 | mapS :: Applicative m 122 | => (a -> b) 123 | -> StreamT a m r 124 | -> StreamT b m r 125 | mapS f = 126 | makeTransformer' go 127 | where 128 | go s g = fmap (mapStep f) (g s) 129 | {-# INLINE mapS #-} 130 | 131 | foldlS :: Monad m 132 | => (accum -> a -> accum) 133 | -> accum 134 | -> StreamT a m r 135 | -> m accum 136 | foldlS f accum0 = 137 | makeSink go 138 | where 139 | go s0 g = 140 | loop accum0 s0 141 | where 142 | loop accum s = do 143 | s <- g s 144 | case s of 145 | Done _ -> pure accum 146 | Yield s' a -> 147 | let !accum' = f accum a 148 | in loop accum' s' 149 | Skip s' -> loop accum s' 150 | {-# INLINE foldlS #-} 151 | 152 | sumS :: (Monad m, Num a) 153 | => StreamT a m r 154 | -> m a 155 | sumS = foldlS (+) 0 156 | {-# INLINE sumS #-} 157 | 158 | sinkListS :: Monad m 159 | => StreamT i m r 160 | -> m [i] 161 | sinkListS = 162 | fmap ($ []) . foldlS go id 163 | where 164 | go front x = front . (x:) 165 | {-# INLINE sinkListS #-} 166 | 167 | mapM_S :: Monad m 168 | => (i -> m a) 169 | -> StreamT i m r 170 | -> m () 171 | mapM_S f = 172 | makeSink go 173 | where 174 | go s0 g = 175 | let loop s = do 176 | step <- g s 177 | case step of 178 | Done _ -> pure () 179 | Yield s' i -> f i *> loop s' 180 | Skip s' -> loop s' 181 | in loop s0 182 | {-# INLINE mapM_S #-} 183 | 184 | readFileS :: (Catch.MonadMask m, MonadIO m) 185 | => FilePath 186 | -> StreamT S.ByteString m () 187 | readFileS fp = makeSourceWith 188 | (Catch.bracket 189 | (liftIO (FR.openFile fp)) 190 | (liftIO . FR.closeFile)) 191 | go 192 | where 193 | go h = 194 | liftIO $ fmap toStep $ FR.readChunk h 195 | where 196 | toStep bs 197 | | S.null bs = Done () 198 | | otherwise = Yield h bs 199 | {-# INLINE readFileS #-} 200 | 201 | writeFileS :: (Catch.MonadMask m, MonadIO m) 202 | => FilePath 203 | -> StreamT S.ByteString m () 204 | -> m () 205 | writeFileS fp stream = Catch.bracket 206 | (liftIO $ IO.openBinaryFile fp IO.WriteMode) 207 | (liftIO . IO.hClose) 208 | (\h -> mapM_S (liftIO . S.hPut h) stream) 209 | {-# INLINE writeFileS #-} 210 | 211 | linesAsciiS :: Monad m 212 | => (accum -> StreamT S.ByteString m () -> StreamT o m accum) 213 | -> accum 214 | -> StreamT S.ByteString m r 215 | -> StreamT o m accum 216 | linesAsciiS inner accum0 = 217 | makeTransformer accum0 go 218 | where 219 | go accum s f = do 220 | step <- f s 221 | case step of 222 | Done _ -> pure (Done accum) 223 | Skip s' -> pure (Skip (accum, s')) 224 | Yield s' bs 225 | | S.null bs -> pure (Skip (accum, s')) 226 | | otherwise -> error "FIXME maybe this isn't possible after all" 227 | {-# INLINE linesAsciiS #-} 228 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # Copy these contents into the root directory of your Github project in a file 2 | # named .travis.yml 3 | 4 | # Use new container infrastructure to enable caching 5 | sudo: false 6 | 7 | # Choose a lightweight base image; we provide our own build tools. 8 | language: c 9 | 10 | # Caching so the next build will be fast too. 11 | cache: 12 | directories: 13 | - $HOME/.ghc 14 | - $HOME/.cabal 15 | - $HOME/.stack 16 | 17 | # The different configurations we want to test. We have BUILD=cabal which uses 18 | # cabal-install, and BUILD=stack which uses Stack. More documentation on each 19 | # of those below. 20 | # 21 | # We set the compiler values here to tell Travis to use a different 22 | # cache file per set of arguments. 23 | # 24 | # If you need to have different apt packages for each combination in the 25 | # matrix, you can use a line such as: 26 | # addons: {apt: {packages: [libfcgi-dev,libgmp-dev]}} 27 | matrix: 28 | include: 29 | # We grab the appropriate GHC and cabal-install versions from hvr's PPA. See: 30 | # https://github.com/hvr/multi-ghc-travis 31 | #- env: BUILD=cabal GHCVER=7.0.4 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7 32 | # compiler: ": #GHC 7.0.4" 33 | # addons: {apt: {packages: [cabal-install-1.16,ghc-7.0.4,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 34 | #- env: BUILD=cabal GHCVER=7.2.2 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7 35 | # compiler: ": #GHC 7.2.2" 36 | # addons: {apt: {packages: [cabal-install-1.16,ghc-7.2.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 37 | #- env: BUILD=cabal GHCVER=7.4.2 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7 38 | # compiler: ": #GHC 7.4.2" 39 | # addons: {apt: {packages: [cabal-install-1.16,ghc-7.4.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 40 | #- env: BUILD=cabal GHCVER=7.6.3 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7 41 | # compiler: ": #GHC 7.6.3" 42 | # addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 43 | #- env: BUILD=cabal GHCVER=7.8.4 CABALVER=1.18 HAPPYVER=1.19.5 ALEXVER=3.1.7 44 | # compiler: ": #GHC 7.8.4" 45 | # addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 46 | - env: BUILD=cabal GHCVER=7.10.3 CABALVER=1.22 HAPPYVER=1.19.5 ALEXVER=3.1.7 47 | compiler: ": #GHC 7.10.3" 48 | addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 49 | 50 | # Build with the newest GHC and cabal-install. This is an accepted failure, 51 | # see below. 52 | - env: BUILD=cabal GHCVER=head CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7 53 | compiler: ": #GHC HEAD" 54 | addons: {apt: {packages: [cabal-install-head,ghc-head,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 55 | 56 | # The Stack builds. We can pass in arbitrary Stack arguments via the ARGS 57 | # variable, such as using --stack-yaml to point to a different file. 58 | - env: BUILD=stack ARGS="" 59 | compiler: ": #stack default" 60 | addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} 61 | 62 | #- env: BUILD=stack ARGS="--resolver lts-2" 63 | # compiler: ": #stack 7.8.4" 64 | # addons: {apt: {packages: [ghc-7.8.4], sources: [hvr-ghc]}} 65 | 66 | #- env: BUILD=stack ARGS="--resolver lts-3" 67 | # compiler: ": #stack 7.10.2" 68 | # addons: {apt: {packages: [ghc-7.10.2], sources: [hvr-ghc]}} 69 | 70 | - env: BUILD=stack ARGS="--resolver lts-5" 71 | compiler: ": #stack 7.10.3" 72 | addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} 73 | 74 | # Nightly builds are allowed to fail 75 | - env: BUILD=stack ARGS="--resolver nightly" 76 | compiler: ": #stack nightly" 77 | addons: {apt: {packages: [libgmp,libgmp-dev]}} 78 | 79 | # Build on OS X in addition to Linux 80 | - env: BUILD=stack ARGS="" 81 | compiler: ": #stack default osx" 82 | os: osx 83 | 84 | #- env: BUILD=stack ARGS="--resolver lts-2" 85 | # compiler: ": #stack 7.8.4 osx" 86 | # os: osx 87 | 88 | #- env: BUILD=stack ARGS="--resolver lts-3" 89 | # compiler: ": #stack 7.10.2 osx" 90 | # os: osx 91 | 92 | - env: BUILD=stack ARGS="--resolver lts-5" 93 | compiler: ": #stack 7.10.3 osx" 94 | os: osx 95 | 96 | - env: BUILD=stack ARGS="--resolver nightly" 97 | compiler: ": #stack nightly osx" 98 | os: osx 99 | 100 | allow_failures: 101 | - env: BUILD=cabal GHCVER=head CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7 102 | - env: BUILD=stack ARGS="--resolver nightly" 103 | 104 | before_install: 105 | # Using compiler above sets CC to an invalid value, so unset it 106 | - unset CC 107 | 108 | # We want to always allow newer versions of packages when building on GHC HEAD 109 | - CABALARGS="" 110 | - if [ "x$GHCVER" = "xhead" ]; then CABALARGS=--allow-newer; fi 111 | 112 | # Download and unpack the stack executable 113 | - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$HOME/.local/bin:/opt/alex/$ALEXVER/bin:/opt/happy/$HAPPYVER/bin:$HOME/.cabal/bin:$PATH 114 | - mkdir -p ~/.local/bin 115 | - | 116 | if [ `uname` = "Darwin" ] 117 | then 118 | travis_retry curl --insecure -L https://www.stackage.org/stack/osx-x86_64 | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin 119 | else 120 | travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 121 | fi 122 | 123 | # Use the more reliable S3 mirror of Hackage 124 | mkdir -p $HOME/.cabal 125 | echo 'remote-repo: hackage.haskell.org:http://hackage.fpcomplete.com/' > $HOME/.cabal/config 126 | echo 'remote-repo-cache: $HOME/.cabal/packages' >> $HOME/.cabal/config 127 | 128 | if [ "$CABALVER" != "1.16" ] 129 | then 130 | echo 'jobs: $ncpus' >> $HOME/.cabal/config 131 | fi 132 | 133 | # Get the list of packages from the stack.yaml file 134 | - PACKAGES=$(stack --install-ghc query locals | grep '^ *path' | sed 's@^ *path:@@') 135 | 136 | install: 137 | - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" 138 | - if [ -f configure.ac ]; then autoreconf -i; fi 139 | - | 140 | set -ex 141 | case "$BUILD" in 142 | stack) 143 | stack --no-terminal --install-ghc $ARGS test --only-dependencies 144 | ;; 145 | cabal) 146 | cabal --version 147 | travis_retry cabal update 148 | cabal install --only-dependencies --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES 149 | ;; 150 | esac 151 | set +ex 152 | 153 | script: 154 | - | 155 | set -ex 156 | case "$BUILD" in 157 | stack) 158 | stack --no-terminal $ARGS test --haddock --no-haddock-deps 159 | ;; 160 | cabal) 161 | cabal install --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES 162 | 163 | ORIGDIR=$(pwd) 164 | for dir in $PACKAGES 165 | do 166 | cd $dir 167 | cabal check || [ "$CABALVER" == "1.16" ] 168 | cabal sdist 169 | SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && \ 170 | (cd dist && cabal install --force-reinstalls "$SRC_TGZ") 171 | cd $ORIGDIR 172 | done 173 | ;; 174 | esac 175 | set +ex 176 | --------------------------------------------------------------------------------