list-t 1.0.5.6 → 1.0.5.7
raw patch · 4 files changed
+76/−58 lines, 4 filesdep ~foldlPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: foldl
API changes (from Hackage documentation)
Files
- htf-test/Main.hs +20/−3
- library/ListT.hs +41/−40
- library/ListT/Prelude.hs +4/−4
- list-t.cabal +11/−11
htf-test/Main.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# OPTIONS_GHC -F -pgmF htfpp -Wno-redundant-constraints #-} import BasePrelude hiding (toList) import Control.Monad.Morph@@ -6,16 +6,19 @@ import MTLPrelude import Test.Framework -main = htfMain $ htf_thisModulesTests+main :: IO ()+main = htfMain htf_thisModulesTests -- * MMonad -- embed lift = id+prop_mmonadLaw1 :: [Int] -> Bool prop_mmonadLaw1 (l :: [Int]) = let s = L.fromFoldable l in runIdentity $ streamsEqual s (embed lift s) -- embed f (lift m) = f m+prop_mmonadLaw2 :: [Int] -> Bool prop_mmonadLaw2 l = let s = (L.fromFoldable :: [Int] -> L.ListT Identity Int) l f = MaybeT . fmap Just@@ -25,11 +28,13 @@ -- * Applicative +prop_applicativeIdentityLaw :: [Int] -> Bool prop_applicativeIdentityLaw (l :: [Int]) = runIdentity $ streamsEqual (pure id <*> s) s where s = L.fromFoldable l +prop_applicativeBehavesLikeList :: [Int] -> Bool prop_applicativeBehavesLikeList = \(ns :: [Int]) -> let a = fs <*> ns@@ -40,17 +45,20 @@ -- * Monad +test_monadLaw1 :: IO () test_monadLaw1 = assertBool =<< streamsEqual (return a >>= k) (k a) where a = 2 k a = return $ chr a +test_monadLaw2 :: IO () test_monadLaw2 = assertBool =<< streamsEqual (m >>= return) m where m = L.fromFoldable ['a' .. 'z'] +test_monadLaw3 :: IO () test_monadLaw3 = assertBool =<< streamsEqual (m >>= (\x -> k x >>= h)) ((m >>= k) >>= h) where@@ -58,6 +66,7 @@ k a = return $ ord a h a = return $ a + 1 +test_monadLaw4 :: IO () test_monadLaw4 = assertBool =<< streamsEqual (fmap f xs) (xs >>= return . f) where@@ -66,18 +75,21 @@ -- * Monoid +test_mappend :: IO () test_mappend = assertBool =<< streamsEqual (L.fromFoldable [0 .. 7]) (L.fromFoldable [0 .. 3] <> L.fromFoldable [4 .. 7]) +test_mappendAndTake :: IO () test_mappendAndTake = assertBool =<< streamsEqual (L.fromFoldable [0 .. 5]) (L.take 6 $ L.fromFoldable [0 .. 3] <> L.fromFoldable [4 .. 7]) +test_mappendDoesntCauseTraversal :: IO () test_mappendDoesntCauseTraversal = do ref <- newIORef 0@@ -93,10 +105,12 @@ -- * Other +test_repeat :: IO () test_repeat = assertEqual [2, 2, 2] =<< do toList $ L.take 3 $ L.repeat (2 :: Int) +test_traverseDoesntCauseTraversal :: IO () test_traverseDoesntCauseTraversal = do ref <- newIORef 0@@ -114,6 +128,7 @@ stream3 = L.take 3 stream2 +test_takeDoesntCauseTraversal :: IO () test_takeDoesntCauseTraversal = do ref <- newIORef 0@@ -127,15 +142,17 @@ liftIO $ modifyIORef ref (+ 1) return x +test_drop :: IO () test_drop = assertEqual [3, 4] =<< do toList $ L.drop 2 $ L.fromFoldable [1 .. 4] +test_slice :: IO () 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 :: (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
library/ListT.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-dodgy-imports #-}+ module ListT ( ListT (..), @@ -38,7 +40,6 @@ ) where -import Control.Monad import ListT.Prelude hiding (drop, fold, head, null, repeat, splitAt, tail, take, toList, traverse, traverse_, uncons, yield) -- |@@ -53,27 +54,27 @@ = ListT (m (Maybe (a, ListT m a))) deriving (Foldable, Traversable, Generic) -deriving instance Show (m (Maybe (a, ListT m a))) => Show (ListT m a)+deriving instance (Show (m (Maybe (a, ListT m a)))) => Show (ListT m a) -deriving instance Read (m (Maybe (a, ListT m a))) => Read (ListT m a)+deriving instance (Read (m (Maybe (a, ListT m a)))) => Read (ListT m a) -deriving instance Eq (m (Maybe (a, ListT m a))) => Eq (ListT m a)+deriving instance (Eq (m (Maybe (a, ListT m a)))) => Eq (ListT m a) -deriving instance Ord (m (Maybe (a, ListT m a))) => Ord (ListT m a)+deriving instance (Ord (m (Maybe (a, ListT m a)))) => Ord (ListT m a) deriving instance (Typeable m, Typeable a, Data (m (Maybe (a, ListT m a)))) => Data (ListT m a) -instance Eq1 m => Eq1 (ListT m) where+instance (Eq1 m) => Eq1 (ListT m) where liftEq eq = go where go (ListT m) (ListT n) = liftEq (liftEq (\(a, as) (b, bs) -> eq a b && go as bs)) m n -instance Ord1 m => Ord1 (ListT m) where+instance (Ord1 m) => Ord1 (ListT m) where liftCompare cmp = go where go (ListT m) (ListT n) = liftCompare (liftCompare (\(a, as) (b, bs) -> cmp a b <> go as bs)) m n -instance Show1 m => Show1 (ListT m) where+instance (Show1 m) => Show1 (ListT m) where -- I wish I were joking. liftShowsPrec sp (sl :: [a] -> ShowS) = mark where@@ -98,7 +99,7 @@ jack :: Int -> (a, ListT m a) -> ShowS jack = liftShowsPrec2 sp sl mark juan -instance Monad m => Semigroup (ListT m a) where+instance (Monad m) => Semigroup (ListT m a) where (<>) (ListT m1) (ListT m2) = ListT $ m1@@ -108,13 +109,13 @@ Just (h1, s1') -> return (Just (h1, ((<>) s1' (ListT m2)))) -instance Monad m => Monoid (ListT m a) where+instance (Monad m) => Monoid (ListT m a) where mempty = ListT $ return Nothing mappend = (<>) -instance Functor m => Functor (ListT m) where+instance (Functor m) => Functor (ListT m) where fmap f = go where go =@@ -140,7 +141,7 @@ (<|>) = inline mappend -instance Monad m => Monad (ListT m) where+instance (Monad m) => Monad (ListT m) where return = pure -- We use a go function so GHC can inline k2@@ -156,11 +157,11 @@ Just (h1, t1) -> uncons $ k2 h1 <> go t1 -instance Monad m => MonadFail (ListT m) where+instance (Monad m) => MonadFail (ListT m) where fail _ = inline mempty -instance Monad m => MonadPlus (ListT m) where+instance (Monad m) => MonadPlus (ListT m) where mzero = inline mempty mplus =@@ -170,7 +171,7 @@ lift = ListT . fmap (\a -> Just (a, mempty)) -instance MonadIO m => MonadIO (ListT m) where+instance (MonadIO m) => MonadIO (ListT m) where liftIO = lift . liftIO @@ -189,11 +190,11 @@ Nothing -> mzero Just (h, t) -> ListT $ return $ Just $ (h, embed f t) -instance MonadBase b m => MonadBase b (ListT m) where+instance (MonadBase b m) => MonadBase b (ListT m) where liftBase = lift . liftBase -instance MonadBaseControl b m => MonadBaseControl b (ListT m) where+instance (MonadBaseControl b m) => MonadBaseControl b (ListT m) where type StM (ListT m) a = StM m (Maybe (a, ListT m a))@@ -206,23 +207,23 @@ Nothing -> mzero Just (h, t) -> cons h t -instance MonadError e m => MonadError e (ListT m) where+instance (MonadError e m) => MonadError e (ListT m) where throwError = ListT . throwError catchError m handler = ListT $ catchError (uncons m) $ uncons . handler -instance MonadReader e m => MonadReader e (ListT m) where+instance (MonadReader e m) => MonadReader e (ListT m) where ask = lift ask reader = lift . reader local r = go where go (ListT m) = ListT $ local r (fmap (fmap (secondPair' go)) m) -instance MonadState e m => MonadState e (ListT m) where+instance (MonadState e m) => MonadState e (ListT m) where get = lift get put = lift . put state = lift . state -instance Monad m => MonadLogic (ListT m) where+instance (Monad m) => MonadLogic (ListT m) where msplit (ListT m) = lift m interleave m1 m2 =@@ -255,7 +256,7 @@ Nothing -> uncons (return ()) Just _ -> uncons empty -instance MonadZip m => MonadZip (ListT m) where+instance (MonadZip m) => MonadZip (ListT m) where mzipWith f = go where go (ListT m1) (ListT m2) =@@ -299,21 +300,21 @@ -- | -- Execute, getting the head. Returns nothing if it's empty. {-# INLINEABLE head #-}-head :: Monad m => ListT m a -> m (Maybe a)+head :: (Monad m) => ListT m a -> m (Maybe a) head = fmap (fmap fst) . uncons -- | -- Execute, getting the tail. Returns nothing if it's empty. {-# INLINEABLE tail #-}-tail :: Monad m => ListT m a -> m (Maybe (ListT m a))+tail :: (Monad m) => ListT m a -> m (Maybe (ListT m a)) tail = fmap (fmap snd) . uncons -- | -- Execute, checking whether it's empty. {-# INLINEABLE null #-}-null :: Monad m => ListT m a -> m Bool+null :: (Monad m) => ListT m a -> m Bool null = fmap (maybe True (const False)) . uncons @@ -344,7 +345,7 @@ -- | -- Execute, applying a strict left fold. {-# INLINEABLE fold #-}-fold :: Monad m => (b -> a -> m b) -> b -> ListT m a -> m b+fold :: (Monad m) => (b -> a -> m b) -> b -> ListT m a -> m b fold step = go where go !acc (ListT run) =@@ -358,7 +359,7 @@ -- | -- A version of 'fold', which allows early termination. {-# INLINEABLE foldMaybe #-}-foldMaybe :: Monad m => (b -> a -> m (Maybe b)) -> b -> ListT m a -> m b+foldMaybe :: (Monad m) => (b -> a -> m (Maybe b)) -> b -> ListT m a -> m b foldMaybe s r l = fmap (maybe r id) $ runMaybeT $ do@@ -368,7 +369,7 @@ -- | -- Apply the left fold abstraction from the \"foldl\" package.-applyFoldM :: Monad m => FoldM m i o -> ListT m i -> m o+applyFoldM :: (Monad m) => FoldM m i o -> ListT m i -> m o applyFoldM (FoldM step init extract) lt = do a <- init b <- fold step a lt@@ -377,7 +378,7 @@ -- | -- Execute, folding to a list. {-# INLINEABLE toList #-}-toList :: Monad m => ListT m a -> m [a]+toList :: (Monad m) => ListT m a -> m [a] toList = fmap reverse . toReverseList @@ -385,21 +386,21 @@ -- Execute, folding to a list in the reverse order. -- Performs more efficiently than 'toList'. {-# INLINEABLE toReverseList #-}-toReverseList :: Monad m => ListT m a -> m [a]+toReverseList :: (Monad m) => ListT m a -> m [a] toReverseList = fold (\list element -> return (element : list)) [] -- | -- Execute, traversing the stream with a side effect in the inner monad. {-# INLINEABLE traverse_ #-}-traverse_ :: Monad m => (a -> m ()) -> ListT m a -> m ()+traverse_ :: (Monad m) => (a -> m ()) -> ListT m a -> m () traverse_ f = fold (const f) () -- | -- Execute, consuming a list of the specified length and returning the remainder stream. {-# INLINEABLE splitAt #-}-splitAt :: Monad m => Int -> ListT m a -> m ([a], ListT m a)+splitAt :: (Monad m) => Int -> ListT m a -> m ([a], ListT m a) splitAt = \case n | n > 0 -> \l ->@@ -417,7 +418,7 @@ -- | -- Prepend an element.-cons :: Monad m => a -> ListT m a -> ListT m a+cons :: (Monad m) => a -> ListT m a -> ListT m a cons h t = ListT $ return (Just (h, t)) @@ -437,7 +438,7 @@ -- | -- Construct by unfolding a pure data structure. {-# INLINEABLE unfold #-}-unfold :: Monad m => (b -> Maybe (a, b)) -> b -> ListT m a+unfold :: (Monad m) => (b -> Maybe (a, b)) -> b -> ListT m a unfold f s = maybe mzero (\(h, t) -> cons h (unfold f t)) (f s) @@ -447,7 +448,7 @@ -- This is the most memory-efficient way to construct ListT where -- the length depends on the inner monad. {-# INLINEABLE unfoldM #-}-unfoldM :: Monad m => (b -> m (Maybe (a, b))) -> b -> ListT m a+unfoldM :: (Monad m) => (b -> m (Maybe (a, b))) -> b -> ListT m a unfoldM f = go where go s =@@ -459,7 +460,7 @@ -- | -- Produce an infinite stream. {-# INLINEABLE repeat #-}-repeat :: Monad m => a -> ListT m a+repeat :: (Monad m) => a -> ListT m a repeat = fix . cons @@ -471,7 +472,7 @@ -- A transformation, -- which traverses the stream with an action in the inner monad. {-# INLINEABLE traverse #-}-traverse :: Monad m => (a -> m b) -> ListT m a -> ListT m b+traverse :: (Monad m) => (a -> m b) -> ListT m a -> ListT m b traverse f = go where@@ -485,7 +486,7 @@ -- A transformation, -- reproducing the behaviour of @Data.List.'Data.List.take'@. {-# INLINEABLE take #-}-take :: Monad m => Int -> ListT m a -> ListT m a+take :: (Monad m) => Int -> ListT m a -> ListT m a take = \case n | n > 0 -> \t ->@@ -500,7 +501,7 @@ -- A transformation, -- reproducing the behaviour of @Data.List.'Data.List.drop'@. {-# INLINEABLE drop #-}-drop :: Monad m => Int -> ListT m a -> ListT m a+drop :: (Monad m) => Int -> ListT m a -> ListT m a drop = \case n@@ -513,7 +514,7 @@ -- A transformation, -- which slices a list into chunks of the specified length. {-# INLINEABLE slice #-}-slice :: Monad m => Int -> ListT m a -> ListT m [a]+slice :: (Monad m) => Int -> ListT m a -> ListT m [a] slice n l = do (h, t) <- lift $ splitAt n l
library/ListT/Prelude.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-dodgy-imports #-}+ module ListT.Prelude ( module Exports, bimapPair',@@ -36,7 +38,7 @@ import Data.Fixed as Exports import Data.Foldable as Exports import Data.Function as Exports hiding (id, (.))-import Data.Functor as Exports+import Data.Functor as Exports hiding (unzip) import Data.Functor.Classes as Exports import Data.IORef as Exports import Data.Int as Exports@@ -73,12 +75,10 @@ import System.Mem as Exports import System.Mem.StableName as Exports import System.Timeout as Exports-import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P)-import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readP_to_Prec, readPrec_to_P, readPrec_to_S, readS_to_Prec) import Text.Printf as Exports (hPrintf, printf) import Text.Read as Exports (Read (..), readEither, readMaybe) import Unsafe.Coerce as Exports-import Prelude as Exports hiding (all, and, any, concat, concatMap, elem, fail, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.))+import Prelude as Exports hiding (all, and, any, concat, concatMap, elem, fail, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, unzip, (.)) -- | -- A slightly stricter version of Data.Bifunctor.bimap.
list-t.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: list-t-version: 1.0.5.6+version: 1.0.5.7 synopsis: ListT done right description: A correct implementation of the list monad-transformer.@@ -66,14 +66,14 @@ exposed-modules: ListT other-modules: ListT.Prelude build-depends:- , 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+ , base >=4.11 && <5+ , foldl >=1.2 && <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 if impl(ghc <8.0) build-depends: semigroups >=0.11 && <0.21@@ -85,7 +85,7 @@ main-is: Main.hs build-depends: , base-prelude- , HTF ^>=0.15+ , HTF ^>=0.15 , list-t , mmorph- , mtl-prelude <3+ , mtl-prelude <3