list-t 1.0.5.3 → 1.0.5.4
raw patch · 4 files changed
+224/−187 lines, 4 filesdep ~HTFdep ~transformers-basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: HTF, transformers-base
API changes (from Hackage documentation)
Files
- htf-test/Main.hs +143/−0
- library/ListT.hs +4/−4
- list-t.cabal +77/−40
- tests/Main.hs +0/−143
+ htf-test/Main.hs view
@@ -0,0 +1,143 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}++import BasePrelude hiding (toList)+import Control.Monad.Morph+import qualified ListT as L+import MTLPrelude+import Test.Framework++main = htfMain $ htf_thisModulesTests++-- * MMonad++-- embed lift = id+prop_mmonadLaw1 (l :: [Int]) =+ let s = L.fromFoldable l+ in runIdentity $ streamsEqual s (embed lift s)++-- embed f (lift m) = f m+prop_mmonadLaw2 l =+ let s = (L.fromFoldable :: [Int] -> L.ListT Identity Int) l+ f = MaybeT . fmap Just+ run = runIdentity . L.toList . runMaybeT+ in run (f s)+ == run (embed f (lift s))++-- * Applicative++prop_applicativeIdentityLaw (l :: [Int]) =+ runIdentity $ streamsEqual (pure id <*> s) s+ where+ s = L.fromFoldable l++prop_applicativeBehavesLikeList =+ \(ns :: [Int]) ->+ let a = fs <*> ns+ b = runIdentity (toList $ L.fromFoldable fs <*> L.fromFoldable ns)+ in a == b+ where+ fs = [(+ 1), (+ 3), (+ 5)]++-- * Monad++test_monadLaw1 =+ assertBool =<< streamsEqual (return a >>= k) (k a)+ where+ a = 2+ k a = return $ chr a++test_monadLaw2 =+ assertBool =<< streamsEqual (m >>= return) m+ where+ m = L.fromFoldable ['a' .. 'z']++test_monadLaw3 =+ assertBool =<< streamsEqual (m >>= (\x -> k x >>= h)) ((m >>= k) >>= h)+ where+ m = L.fromFoldable ['a' .. 'z']+ k a = return $ ord a+ h a = return $ a + 1++test_monadLaw4 =+ assertBool =<< streamsEqual (fmap f xs) (xs >>= return . f)+ where+ f = ord+ xs = L.fromFoldable ['a' .. 'z']++-- * Monoid++test_mappend =+ assertBool+ =<< streamsEqual+ (L.fromFoldable [0 .. 7])+ (L.fromFoldable [0 .. 3] <> L.fromFoldable [4 .. 7])++test_mappendAndTake =+ assertBool+ =<< streamsEqual+ (L.fromFoldable [0 .. 5])+ (L.take 6 $ L.fromFoldable [0 .. 3] <> L.fromFoldable [4 .. 7])++test_mappendDoesntCauseTraversal =+ do+ ref <- newIORef 0+ (flip runReaderT) ref (toList $ L.take 5 $ stream <> stream)+ assertEqual 5 =<< readIORef ref+ where+ stream =+ do+ ref <- lift $ ask+ x <- L.fromFoldable [0 .. 4]+ liftIO $ modifyIORef ref (+ 1)+ return x++-- * Other++test_repeat =+ assertEqual [2, 2, 2] =<< do+ toList $ L.take 3 $ L.repeat (2 :: Int)++test_traverseDoesntCauseTraversal =+ do+ ref <- newIORef 0+ (flip runReaderT) ref (toList stream3)+ assertEqual 3 =<< readIORef ref+ where+ stream1 =+ do+ ref <- lift $ ask+ x <- L.fromFoldable ['a' .. 'z']+ liftIO $ modifyIORef ref (+ 1)+ return x+ stream2 =+ L.traverse (return . toUpper) stream1+ stream3 =+ L.take 3 stream2++test_takeDoesntCauseTraversal =+ do+ ref <- newIORef 0+ (flip runReaderT) ref (toList $ L.take 3 $ L.take 7 $ stream)+ assertEqual 3 =<< readIORef ref+ where+ stream =+ do+ ref <- lift $ ask+ x <- L.fromFoldable [0 .. 10]+ liftIO $ modifyIORef ref (+ 1)+ return x++test_drop =+ assertEqual [3, 4] =<< do+ toList $ L.drop 2 $ L.fromFoldable [1 .. 4]++test_slice =+ assertEqual ["abc", "def", "gh"] =<< do+ toList $ L.slice 3 $ L.fromFoldable ("abcdefgh" :: [Char])++toList :: Monad m => L.ListT m a -> m [a]+toList = L.toList++streamsEqual :: (Applicative m, Monad m, Eq a) => L.ListT m a -> L.ListT m a -> m Bool+streamsEqual a b =+ (==) <$> L.toList a <*> L.toList b
library/ListT.hs view
@@ -338,11 +338,11 @@ Just (a, as) -> pure a <|> go as -- |--- Execute, applying a left fold.+-- Execute, applying a strict left fold. {-# INLINEABLE fold #-} fold :: Monad m => (r -> a -> m r) -> r -> ListT m a -> m r fold s r =- uncons >=> maybe (return r) (\(h, t) -> s r h >>= \r' -> fold s r' t)+ uncons >=> maybe (return r) (\(!h, t) -> s r h >>= \r' -> fold s r' t) -- | -- A version of 'fold', which allows early termination.@@ -368,7 +368,7 @@ {-# INLINEABLE toList #-} toList :: Monad m => ListT m a -> m [a] toList =- liftM ($ []) . fold (\f e -> return $ f . (e :)) id+ fmap reverse . toReverseList -- | -- Execute, folding to a list in the reverse order.@@ -376,7 +376,7 @@ {-# INLINEABLE toReverseList #-} toReverseList :: Monad m => ListT m a -> m [a] toReverseList =- ListT.fold (\l -> return . (: l)) []+ fold (\list element -> return (element : list)) [] -- | -- Execute, traversing the stream with a side effect in the inner monad.
list-t.cabal view
@@ -1,54 +1,91 @@ cabal-version: 3.0--name: list-t-version: 1.0.5.3-synopsis: ListT done right+name: list-t+version: 1.0.5.4+synopsis: ListT done right description: A correct implementation of the list monad-transformer. Useful for basic streaming.-category: Streaming, Data Structures, Control-homepage: https://github.com/nikita-volkov/list-t-bug-reports: https://github.com/nikita-volkov/list-t/issues-author: Nikita Volkov <nikita.y.volkov@mail.ru>-maintainer: Nikita Volkov <nikita.y.volkov@mail.ru>-copyright: (c) 2014, Nikita Volkov-license: MIT-license-file: LICENSE +category: Streaming, Data Structures, Control+homepage: https://github.com/nikita-volkov/list-t+bug-reports: https://github.com/nikita-volkov/list-t/issues+author: Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer: Nikita Volkov <nikita.y.volkov@mail.ru>+copyright: (c) 2014, Nikita Volkov+license: MIT+license-file: LICENSE+ source-repository head- type: git+ type: git location: git://github.com/nikita-volkov/list-t.git common language-settings- default-extensions: BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, PolyKinds, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples, UndecidableInstances- default-language: Haskell2010+ default-extensions:+ NoImplicitPrelude+ NoMonomorphismRestriction+ BangPatterns+ ConstraintKinds+ DataKinds+ DefaultSignatures+ DeriveDataTypeable+ DeriveFunctor+ DeriveGeneric+ DeriveTraversable+ EmptyDataDecls+ FlexibleContexts+ FlexibleInstances+ FunctionalDependencies+ GADTs+ GeneralizedNewtypeDeriving+ LambdaCase+ LiberalTypeSynonyms+ MagicHash+ MultiParamTypeClasses+ MultiWayIf+ OverloadedStrings+ ParallelListComp+ PatternGuards+ PolyKinds+ QuasiQuotes+ RankNTypes+ RecordWildCards+ ScopedTypeVariables+ StandaloneDeriving+ TemplateHaskell+ TupleSections+ TypeFamilies+ TypeOperators+ UnboxedTuples+ UndecidableInstances + default-language: Haskell2010+ library- import: language-settings- hs-source-dirs: library- exposed-modules:- ListT- other-modules:- ListT.Prelude+ import: language-settings+ hs-source-dirs: library+ exposed-modules: ListT+ other-modules: ListT.Prelude build-depends:- base >=4.11 && <5,- foldl >=1 && <2,- logict >=0.7 && <0.9,- mmorph ==1.*,- monad-control >=0.3 && <2,- mtl ==2.*,- semigroups >=0.11 && <0.21,- transformers >=0.3 && <0.7,- transformers-base ==0.4.*+ , base >=4.11 && <5+ , foldl >=1 && <2+ , logict >=0.7 && <0.9+ , mmorph >=1 && <2+ , monad-control >=0.3 && <2+ , mtl >=2 && <3+ , transformers >=0.3 && <0.7+ , transformers-base ^>=0.4 -test-suite tests- import: language-settings- type: exitcode-stdio-1.0- hs-source-dirs: tests- main-is: Main.hs+ if impl(ghc <8.0)+ build-depends: semigroups >=0.11 && <0.21++test-suite htf-test+ import: language-settings+ type: exitcode-stdio-1.0+ hs-source-dirs: htf-test+ main-is: Main.hs build-depends:- list-t,- mmorph,- HTF >=0.13 && <0.16,- mtl-prelude <3,- base-prelude+ , base-prelude+ , HTF ^>=0.15+ , list-t+ , mmorph+ , mtl-prelude <3
− tests/Main.hs
@@ -1,143 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}--import BasePrelude hiding (toList)-import Control.Monad.Morph-import qualified ListT as L-import MTLPrelude-import Test.Framework--main = htfMain $ htf_thisModulesTests---- * MMonad---- embed lift = id-prop_mmonadLaw1 (l :: [Int]) =- let s = L.fromFoldable l- in runIdentity $ streamsEqual s (embed lift s)---- embed f (lift m) = f m-prop_mmonadLaw2 l =- let s = (L.fromFoldable :: [Int] -> L.ListT Identity Int) l- f = MaybeT . fmap Just- run = runIdentity . L.toList . runMaybeT- in run (f s)- == run (embed f (lift s))---- * Applicative--prop_applicativeIdentityLaw (l :: [Int]) =- runIdentity $ streamsEqual (pure id <*> s) s- where- s = L.fromFoldable l--prop_applicativeBehavesLikeList =- \(ns :: [Int]) ->- let a = fs <*> ns- b = runIdentity (toList $ L.fromFoldable fs <*> L.fromFoldable ns)- in a == b- where- fs = [(+ 1), (+ 3), (+ 5)]---- * Monad--test_monadLaw1 =- assertBool =<< streamsEqual (return a >>= k) (k a)- where- a = 2- k a = return $ chr a--test_monadLaw2 =- assertBool =<< streamsEqual (m >>= return) m- where- m = L.fromFoldable ['a' .. 'z']--test_monadLaw3 =- assertBool =<< streamsEqual (m >>= (\x -> k x >>= h)) ((m >>= k) >>= h)- where- m = L.fromFoldable ['a' .. 'z']- k a = return $ ord a- h a = return $ a + 1--test_monadLaw4 =- assertBool =<< streamsEqual (fmap f xs) (xs >>= return . f)- where- f = ord- xs = L.fromFoldable ['a' .. 'z']---- * Monoid--test_mappend =- assertBool- =<< streamsEqual- (L.fromFoldable [0 .. 7])- (L.fromFoldable [0 .. 3] <> L.fromFoldable [4 .. 7])--test_mappendAndTake =- assertBool- =<< streamsEqual- (L.fromFoldable [0 .. 5])- (L.take 6 $ L.fromFoldable [0 .. 3] <> L.fromFoldable [4 .. 7])--test_mappendDoesntCauseTraversal =- do- ref <- newIORef 0- (flip runReaderT) ref (toList $ L.take 5 $ stream <> stream)- assertEqual 5 =<< readIORef ref- where- stream =- do- ref <- lift $ ask- x <- L.fromFoldable [0 .. 4]- liftIO $ modifyIORef ref (+ 1)- return x---- * Other--test_repeat =- assertEqual [2, 2, 2] =<< do- toList $ L.take 3 $ L.repeat (2 :: Int)--test_traverseDoesntCauseTraversal =- do- ref <- newIORef 0- (flip runReaderT) ref (toList stream3)- assertEqual 3 =<< readIORef ref- where- stream1 =- do- ref <- lift $ ask- x <- L.fromFoldable ['a' .. 'z']- liftIO $ modifyIORef ref (+ 1)- return x- stream2 =- L.traverse (return . toUpper) stream1- stream3 =- L.take 3 stream2--test_takeDoesntCauseTraversal =- do- ref <- newIORef 0- (flip runReaderT) ref (toList $ L.take 3 $ L.take 7 $ stream)- assertEqual 3 =<< readIORef ref- where- stream =- do- ref <- lift $ ask- x <- L.fromFoldable [0 .. 10]- liftIO $ modifyIORef ref (+ 1)- return x--test_drop =- assertEqual [3, 4] =<< do- toList $ L.drop 2 $ L.fromFoldable [1 .. 4]--test_slice =- assertEqual ["abc", "def", "gh"] =<< do- toList $ L.slice 3 $ L.fromFoldable ("abcdefgh" :: [Char])--toList :: Monad m => L.ListT m a -> m [a]-toList = L.toList--streamsEqual :: (Applicative m, Monad m, Eq a) => L.ListT m a -> L.ListT m a -> m Bool-streamsEqual a b =- (==) <$> L.toList a <*> L.toList b