├── .gitignore ├── .travis.yml ├── LICENSE ├── README.md ├── Setup.hs ├── bench └── bench.hs ├── src ├── Gotenks.hs └── Vegito.hs ├── stack.yaml ├── test ├── GotenksSpec.hs ├── Spec.hs └── VegitoSpec.hs └── vegito.cabal /.gitignore: -------------------------------------------------------------------------------- 1 | *.swp 2 | .stack-work 3 | -------------------------------------------------------------------------------- /.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.10.3 CABALVER=1.22 32 | compiler: ": #GHC 7.10.3" 33 | addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}} 34 | 35 | # Build with the newest GHC and cabal-install. This is an accepted failure, 36 | # see below. 37 | - env: BUILD=cabal GHCVER=head CABALVER=head 38 | compiler: ": #GHC HEAD" 39 | addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}} 40 | 41 | # The Stack builds. We can pass in arbitrary Stack arguments via the ARGS 42 | # variable, such as using --stack-yaml to point to a different file. 43 | - env: BUILD=stack ARGS="--resolver lts-3" 44 | compiler: ": #stack 7.10.2" 45 | addons: {apt: {packages: [ghc-7.10.2], sources: [hvr-ghc]}} 46 | 47 | - env: BUILD=stack ARGS="--resolver lts-5" 48 | compiler: ": #stack 7.10.3" 49 | addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} 50 | 51 | # Nightly builds are allowed to fail 52 | - env: BUILD=stack ARGS="--resolver nightly" 53 | compiler: ": #stack nightly" 54 | addons: {apt: {packages: [libgmp-dev]}} 55 | 56 | # Build on OS X in addition to Linux 57 | - env: BUILD=stack ARGS="--resolver lts-3" 58 | compiler: ": #stack 7.10.2 osx" 59 | os: osx 60 | 61 | - env: BUILD=stack ARGS="--resolver lts-5" 62 | compiler: ": #stack 7.10.3 osx" 63 | os: osx 64 | 65 | - env: BUILD=stack ARGS="--resolver nightly" 66 | compiler: ": #stack nightly osx" 67 | os: osx 68 | 69 | allow_failures: 70 | - env: BUILD=cabal GHCVER=head CABALVER=head 71 | - env: BUILD=stack ARGS="--resolver nightly" 72 | 73 | before_install: 74 | # Using compiler above sets CC to an invalid value, so unset it 75 | - unset CC 76 | 77 | # We want to always allow newer versions of packages when building on GHC HEAD 78 | - CABALARGS="" 79 | - if [ "x$GHCVER" = "xhead" ]; then CABALARGS=--allow-newer; fi 80 | 81 | # Download and unpack the stack executable 82 | - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$HOME/.local/bin:$PATH 83 | - mkdir -p ~/.local/bin 84 | - | 85 | if [ `uname` = "Darwin" ] 86 | then 87 | curl --insecure -L https://www.stackage.org/stack/osx-x86_64 | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin 88 | else 89 | curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 90 | fi 91 | 92 | install: 93 | - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" 94 | - if [ -f configure.ac ]; then autoreconf -i; fi 95 | - | 96 | case "$BUILD" in 97 | stack) 98 | stack --no-terminal --install-ghc $ARGS test --only-dependencies 99 | ;; 100 | cabal) 101 | cabal --version 102 | travis_retry cabal update 103 | cabal install --only-dependencies --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS 104 | ;; 105 | esac 106 | 107 | script: 108 | - | 109 | case "$BUILD" in 110 | stack) 111 | stack --no-terminal $ARGS test --haddock --no-haddock-deps 112 | ;; 113 | cabal) 114 | cabal configure --enable-tests --enable-benchmarks -v2 --ghc-options="-O0 -Werror" 115 | cabal build 116 | cabal check || [ "$CABALVER" == "1.16" ] 117 | cabal test 118 | cabal sdist 119 | cabal copy 120 | SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && \ 121 | (cd dist && cabal install --force-reinstalls "$SRC_TGZ") 122 | ;; 123 | esac 124 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016 Michael Snoyman 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 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## vegito 2 | 3 | [![Build Status](https://travis-ci.org/snoyberg/vegito.svg?branch=master)](https://travis-ci.org/snoyberg/vegito) 4 | 5 | Some standalone stream fusion experiments. 6 | 7 | This library is built around testing a thought experiment: stream fusion is 8 | fast, because it's designed to work well with GHC optimizations. Most streaming 9 | libraries (including conduit and pipes) are designed to present a very nice 10 | user-friendly story, while staying as performant as possible. Is it possible to 11 | start with the high-performance stream fusion ideas, and build something 12 | user-friendly from there? 13 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /bench/bench.hs: -------------------------------------------------------------------------------- 1 | import Criterion.Main 2 | 3 | import qualified Conduit as C 4 | import qualified Data.Vector.Unboxed as V 5 | import qualified Data.Vector as VB 6 | import Vegito 7 | import Gotenks 8 | import Data.Functor.Identity 9 | 10 | main :: IO () 11 | main = defaultMain 12 | [ bgroup "sum $ map (+ 1) $ map (* 2) $ enumFromTo 1 9001" 13 | [ bench' "vegito" $ \x -> 14 | runIdentity 15 | $ sumS 16 | $ mapS (+ 1) 17 | $ mapS (* 2) 18 | $ enumFromToS 1 x 19 | , bench' "gotenks" $ \x -> 20 | runIdentity 21 | $ toSink sumG 22 | $ toTransform (mapG (+ 1)) 23 | $ toTransform (mapG (* 2)) 24 | $ toSource (enumFromToG 1 x) 25 | , bench' "conduit-combinators" $ \x -> 26 | runIdentity 27 | $ C.enumFromToC 1 x 28 | C.$= C.mapC (* 2) 29 | C.$= C.mapC (+ 1) 30 | C.$$ C.sumC 31 | , bench' "vector boxed" $ \x -> 32 | VB.sum 33 | $ VB.map (+ 1) 34 | $ VB.map (* 2) 35 | $ VB.enumFromTo 1 x 36 | , bench' "vector unboxed" $ \x -> 37 | V.sum 38 | $ V.map (+ 1) 39 | $ V.map (* 2) 40 | $ V.enumFromTo 1 x 41 | , bench' "vector unboxed foldM" $ \x -> 42 | runIdentity 43 | $ V.foldM (\total i -> return $! total + i) 0 44 | $ V.map (+ 1) 45 | $ V.map (* 2) 46 | $ V.enumFromTo 1 x 47 | ] 48 | ] 49 | where 50 | bench' :: String -> (Int -> Int) -> Benchmark 51 | bench' name f = bench name (whnf f (9001 :: Int)) 52 | -------------------------------------------------------------------------------- /src/Gotenks.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFunctor #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | module Gotenks where 4 | 5 | import Control.Monad (ap) 6 | import Control.Applicative (liftA2) 7 | import Data.Void (Void, absurd) 8 | import Vegito 9 | 10 | data GotenksF i o m r 11 | = YieldF o (GotenksF i o m r) 12 | | AwaitF (i -> GotenksF i o m r) (GotenksF i o m r) 13 | | DoF (m (GotenksF i o m r)) 14 | | DoneF r 15 | | LeftoverF i (GotenksF i o m r) 16 | deriving Functor 17 | 18 | newtype Gotenks i o m r = Gotenks 19 | { unGotenks :: forall b. 20 | (r -> GotenksF i o m b) -> GotenksF i o m b 21 | } 22 | deriving Functor 23 | instance Applicative (Gotenks i o m) where 24 | pure r = Gotenks (\f -> f r) 25 | (<*>) = ap 26 | instance Monad (Gotenks i o m) where 27 | return = pure 28 | (>>) = (*>) 29 | 30 | Gotenks f >>= g = Gotenks (\h -> f $ \a -> unGotenks (g a) h) 31 | instance Monoid r => Monoid (Gotenks i o m r) where 32 | mempty = pure mempty 33 | mappend = liftA2 mappend 34 | 35 | await :: Gotenks i o m (Maybe i) 36 | await = Gotenks (\f -> AwaitF (f . Just) (f Nothing)) 37 | {-# INLINE await #-} 38 | 39 | yield :: o -> Gotenks i o m () 40 | yield o = Gotenks (\f -> YieldF o (f ())) 41 | {-# INLINE yield #-} 42 | 43 | leftover :: i -> Gotenks i o m () 44 | leftover i = Gotenks (\f -> LeftoverF i (f ())) 45 | {-# INLINE leftover #-} 46 | 47 | runGotenks :: Monad m => Gotenks () Void m r -> m r 48 | runGotenks (Gotenks orig) = 49 | loop (orig DoneF) 50 | where 51 | loop (YieldF o _) = absurd o 52 | loop (AwaitF _ f) = loop f 53 | loop (DoF m) = m >>= loop 54 | loop (DoneF r) = pure r 55 | loop (LeftoverF () f) = loop f 56 | 57 | toSource :: Applicative m => Gotenks () o m r -> Stream o m r 58 | toSource (Gotenks orig) = 59 | Stream go (orig DoneF) 60 | where 61 | go (YieldF o f) = pure (Yield f o) 62 | go (AwaitF _ f) = pure (Skip f) 63 | go (DoF f) = fmap Skip f 64 | go (DoneF r) = pure (Done r) 65 | go (LeftoverF () r) = pure (Skip r) 66 | {-# INLINE [0] toSource #-} 67 | 68 | toSink :: Monad m => Gotenks i Void m r -> Stream i m () -> m r 69 | toSink (Gotenks forig) (Stream step sorig) = 70 | let loop _ (DoneF r) _ = pure r 71 | loop _ (YieldF o _) _ = absurd o 72 | loop is (LeftoverF i f) s = loop (i:is) f s 73 | loop is (DoF f) s = f >>= \f' -> loop is f' s 74 | loop (i:is) (AwaitF f _) s = loop is (f i) s 75 | loop [] (AwaitF f g) s = do 76 | x <- step s 77 | case x of 78 | Yield s' i -> loop [] (f i) s' 79 | Skip s' -> loop [] (AwaitF f g) s' 80 | Done () -> finish [] g 81 | 82 | finish _ (DoneF r) = pure r 83 | finish _ (YieldF o _) = absurd o 84 | finish is (LeftoverF i f) = finish (i:is) f 85 | finish is (DoF f) = f >>= \f' -> finish is f' 86 | finish [] (AwaitF _ f) = finish [] f 87 | finish (i:is) (AwaitF f _) = finish is (f i) 88 | in loop [] (forig DoneF) sorig 89 | {-# INLINE [0] toSink #-} 90 | 91 | toTransform :: Applicative m => Gotenks i o m r -> Stream i m () -> Stream o m r 92 | toTransform (Gotenks forig) (Stream step sorig) = 93 | Stream go ([], Just sorig, forig DoneF) 94 | where 95 | go (_, _, DoneF r) = pure (Done r) 96 | go (is, s, YieldF o f) = pure (Yield (is, s, f) o) 97 | go (is, s, LeftoverF i f) = pure (Skip (i:is, s, f)) 98 | go (is, s, DoF f) = fmap (\f' -> Skip (is, s, f')) f 99 | go (i:is, s, AwaitF f _) = pure (Skip (is, s, f i)) 100 | go ([], Just s, AwaitF f g) = do 101 | fmap go' (step s) 102 | where 103 | go' (Yield s' i) = Skip ([], Just s', f i) 104 | go' (Skip s') = Skip ([], Just s', AwaitF f g) 105 | go' (Done ()) = Skip ([], Nothing, g) 106 | go ([], Nothing, AwaitF _ f) = pure (Skip ([], Nothing, f)) 107 | {-# INLINE [0] toTransform #-} 108 | 109 | enumFromToG :: (Ord o, Num o) => o -> o -> Gotenks i o m () 110 | enumFromToG low high = 111 | loop low 112 | where 113 | loop x 114 | | x <= high = yield x >> (loop $! x + 1) 115 | | otherwise = pure () 116 | {-# INLINE [0] enumFromToG #-} 117 | {-# RULES "toSource enumFromToG" 118 | forall x y. toSource (enumFromToG x y) = enumFromToS x y 119 | #-} 120 | 121 | mapG :: (i -> o) -> Gotenks i o m () 122 | mapG f = 123 | loop 124 | where 125 | loop = do 126 | mi <- await 127 | case mi of 128 | Nothing -> pure () 129 | Just i -> yield (f i) *> loop 130 | {-# INLINE [0] mapG #-} 131 | {-# RULES "toTransform mapG" 132 | forall f. toTransform (mapG f) = mapS f 133 | #-} 134 | 135 | foldlG :: (r -> i -> r) -> r -> Gotenks i o m r 136 | foldlG f accum0 = 137 | loop accum0 138 | where 139 | loop accum = do 140 | mi <- await 141 | case mi of 142 | Nothing -> pure accum 143 | Just i -> 144 | let accum' = f accum i 145 | in accum' `seq` loop accum' 146 | {-# INLINE [0] foldlG #-} 147 | {-# RULES "toSink foldlG" 148 | forall f accum. toSink (foldlG f accum) = foldlS f accum 149 | #-} 150 | 151 | sumG :: Num i => Gotenks i o m i 152 | sumG = foldlG (+) 0 153 | {-# INLINE sumG #-} 154 | -------------------------------------------------------------------------------- /src/Vegito.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | {-# LANGUAGE BangPatterns #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | {-# LANGUAGE DeriveFunctor #-} 5 | module Vegito where 6 | 7 | import Control.Applicative (liftA2) 8 | 9 | data Step s o r where 10 | Yield :: s -> o -> Step s o r 11 | Skip :: s -> Step s o r 12 | Done :: r -> Step s o r 13 | deriving Functor 14 | 15 | data Stream o m r where 16 | Stream :: (s -> m (Step s o r)) -> s -> Stream o m r 17 | instance Functor m => Functor (Stream o m) where 18 | fmap f (Stream step s) = Stream (fmap (fmap f) . step) s 19 | instance Applicative m => Applicative (Stream o m) where 20 | pure r = Stream (\() -> pure (Done r)) () 21 | Stream f1 s1orig <*> Stream f2 s2orig = 22 | Stream go (First s1orig s2orig) 23 | where 24 | go (First s1 s2) = 25 | fmap goStep (f1 s1) 26 | where 27 | goStep (Yield s1' o) = Yield (First s1' s2) o 28 | goStep (Skip s1') = Skip (First s1' s2) 29 | goStep (Done r) = Skip (Second r s2) 30 | 31 | go (Second r1 s2) = 32 | fmap goStep (f2 s2) 33 | where 34 | goStep (Yield s2' o) = Yield (Second r1 s2') o 35 | goStep (Skip s2') = Skip (Second r1 s2') 36 | goStep (Done r2) = Done (r1 r2) 37 | 38 | data ApplicativeHelper x y r = First x y | Second r y 39 | 40 | instance Applicative m => Monad (Stream o m) where 41 | return = pure 42 | (>>) = (*>) 43 | Stream f1 s1orig >>= right = 44 | Stream go (Left s1orig) 45 | where 46 | go (Left s1) = 47 | fmap goStep (f1 s1) 48 | where 49 | goStep (Yield s1' o) = Yield (Left s1') o 50 | goStep (Skip s1') = Skip (Left s1') 51 | goStep (Done r) = Skip (Right (right r)) 52 | 53 | go (Right (Stream f2 s2)) = 54 | fmap goStep (f2 s2) 55 | where 56 | goStep (Yield s2' o) = Yield (Right (Stream f2 s2')) o 57 | goStep (Skip s2') = Skip (Right (Stream f2 s2')) 58 | goStep (Done r) = Done r 59 | 60 | instance (Applicative m, Monoid r) => Monoid (Stream o m r) where 61 | mempty = pure mempty 62 | mappend = liftA2 mappend 63 | 64 | enumFromToS :: (Ord o, Applicative m, Num o) => o -> o -> Stream o m () 65 | enumFromToS low high = 66 | Stream go low 67 | where 68 | go x 69 | | x <= high = pure (Yield (x + 1) x) 70 | | otherwise = pure (Done ()) 71 | {-# INLINE enumFromToS #-} 72 | 73 | foldlS :: (Monad m) => (r -> i -> r) -> r -> Stream i m () -> m r 74 | foldlS g accum0 (Stream f sorig) = 75 | let loop accum s = do 76 | step <- f s 77 | case step of 78 | Done () -> pure accum 79 | Skip s' -> loop accum s' 80 | Yield s' i -> 81 | let accum' = g accum i 82 | in accum' `seq` loop accum' s' 83 | in loop accum0 sorig 84 | {-# INLINE foldlS #-} 85 | 86 | sumS :: (Num i, Monad m) => Stream i m () -> m i 87 | sumS = foldlS (+) 0 88 | {-# INLINE sumS #-} 89 | 90 | mapS :: Functor m => (i -> o) -> Stream i m r -> Stream o m r 91 | mapS f (Stream src sorig) = 92 | let go s = fmap goStep (src s) 93 | 94 | goStep (Yield s i) = Yield s (f i) 95 | goStep (Skip s) = Skip s 96 | goStep (Done r) = Done r 97 | 98 | in Stream go sorig 99 | {-# INLINE mapS #-} 100 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration.html 2 | 3 | # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) 4 | resolver: lts-5.2 5 | 6 | # Local packages, usually specified by relative directory name 7 | packages: 8 | - '.' 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 | -------------------------------------------------------------------------------- /test/GotenksSpec.hs: -------------------------------------------------------------------------------- 1 | module GotenksSpec (main, spec) where 2 | 3 | import Test.Hspec 4 | 5 | import Gotenks 6 | import Data.Functor.Identity 7 | 8 | main :: IO () 9 | main = hspec spec 10 | 11 | spec :: Spec 12 | spec = do 13 | it "sanity check" $ 14 | let res = runIdentity 15 | $ toSink sumG 16 | $ toTransform (mapG (+ 1)) 17 | $ toTransform (mapG (* 2)) 18 | $ toSource (enumFromToG 1 9001) 19 | in res `shouldBe` sum (map (+ 1) $ map (* 2) [1..9001 :: Int]) 20 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 2 | -------------------------------------------------------------------------------- /test/VegitoSpec.hs: -------------------------------------------------------------------------------- 1 | module VegitoSpec (main, spec) where 2 | 3 | import Test.Hspec 4 | 5 | import Vegito 6 | import Data.Functor.Identity 7 | 8 | -- `main` is here so that this module can be run from GHCi on its own. It is 9 | -- not needed for automatic spec discovery. 10 | main :: IO () 11 | main = hspec spec 12 | 13 | spec :: Spec 14 | spec = do 15 | describe "sanity" $ do 16 | it "map and sum" $ 17 | runIdentity (sumS $ mapS (+ 1) $ mapS (* 2) $ enumFromToS 1 9001) 18 | `shouldBe` sum (map (+ 1) $ map (* 2) [1..9001 :: Int]) 19 | -------------------------------------------------------------------------------- /vegito.cabal: -------------------------------------------------------------------------------- 1 | name: vegito 2 | version: 0.1.0.0 3 | synopsis: Some standalone stream fusion experiments 4 | description: Please see README.md 5 | homepage: http://github.com/snoyberg/vegito#readme 6 | license: MIT 7 | license-file: LICENSE 8 | author: Michael Snoyman 9 | maintainer: michael@snoyman.com 10 | category: Data 11 | build-type: Simple 12 | cabal-version: >=1.10 13 | 14 | library 15 | hs-source-dirs: src 16 | exposed-modules: Vegito 17 | Gotenks 18 | build-depends: base >= 4.8 && < 5 19 | default-language: Haskell2010 20 | 21 | test-suite vegito-test 22 | type: exitcode-stdio-1.0 23 | hs-source-dirs: test 24 | main-is: Spec.hs 25 | other-modules: VegitoSpec 26 | GotenksSpec 27 | build-depends: base 28 | , vegito 29 | , hspec 30 | , QuickCheck 31 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 32 | default-language: Haskell2010 33 | 34 | benchmark vegito-bench 35 | type: exitcode-stdio-1.0 36 | hs-source-dirs: bench 37 | main-is: bench.hs 38 | build-depends: base 39 | , vegito 40 | , criterion 41 | , vector 42 | , conduit-combinators 43 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2 44 | default-language: Haskell2010 45 | 46 | source-repository head 47 | type: git 48 | location: https://github.com/snoyberg/vegito 49 | --------------------------------------------------------------------------------