ListT 0.1.1.0 → 0.1.2.0

raw patch · 4 files changed

+86/−20 lines, 4 filesdep +ListTdep +smallcheckdep +tastyPVP ok

version bump matches the API change (PVP)

Dependencies added: ListT, smallcheck, tasty, tasty-smallcheck, util

API changes (from Hackage documentation)

Files

• Control/Monad/Trans/List.hs +35/−19
• ListT.cabal +16/−1
• Test/List.hs +27/−0
• test.hs +8/−0

@@ -1,7 +1,9 @@ {-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-} {-# OPTIONS_GHC -Wno-missing-signatures #-} -module Control.Monad.Trans.List (ListT (..), toListM) where+module Control.Monad.Trans.List+  (ListT (..),+   fromList, toListM, toReverseListM, foldlM, traverseM, consF, unfoldrF, splitAtM) where  import Control.Applicative import Control.Arrow@@ -9,18 +11,41 @@ import Control.Monad.Fix import Control.Monad.Trans.Class import Data.Functor.Classes-import Data.List.NonEmpty (NonEmpty (..), intersperse) import Data.Maybe import Data.Monoid hiding ((<>)) import Data.Semigroup+import Util ((*=*), intercalate, list')  newtype ListT m a = ListT { runListT :: m (Maybe (a, ListT m a)) }   deriving (Functor, Foldable, Traversable) +fromList :: (Foldable f, Applicative p) => f a -> ListT p a+fromList = ListT . pure . foldr (\ a -> Just . (,) a . ListT . pure) Nothing+ toListM :: Monad m => ListT m a -> m [a]-toListM (ListT xm) = xm >>= \ case Nothing -> pure []-                                   Just (x, xs) -> (x:) <$> toListM xs+toListM = fmap ($ []) . foldlM (\ f a -> pure (f . (a:))) id +toReverseListM :: Monad m => ListT m a -> m [a]+toReverseListM = foldlM (\ as a -> pure (a:as)) []++foldlM :: Monad m => (b -> a -> m b) -> b -> ListT m a -> m b+foldlM f b = runListT >=> maybe (pure b) (\ (a, as) -> f b a >>= flip (foldlM f) as)++traverseM :: Monad m => (a -> m b) -> ListT m a -> ListT m b+traverseM f = ListT <<< traverse (f *=* pure . traverseM f) <=< runListT++consF :: Functor f => f a -> ListT f a -> ListT f a+consF am as = ListT (Just . flip (,) as <$> am)++unfoldrF :: Functor f => (b -> f (Maybe (a, b))) -> b -> ListT f a+unfoldrF f = ListT . (fmap . fmap) (id *** unfoldrF f) . f++splitAtM :: (Monad m, Integral n) => n -> ListT m a -> m ([a], ListT m a)+splitAtM 0 = pure . (,) []+splitAtM n = runListT >=> \ case+    Nothing -> pure ([], empty)+    Just (a, as) -> ((:) a *** id) <$> splitAtM (n-1) as+ instance MonadTrans ListT where lift = ListT . fmap (Just . flip (,) empty)  instance Eq1 m => Eq1 (ListT m) where@@ -29,8 +54,7 @@  instance Ord1 m => Ord1 (ListT m) where     liftCompare cmp (ListT x) (ListT y) =-        (liftCompare . liftCompare) (\ (x, xs) (y, ys) ->-                                     x `cmp` y <> liftCompare cmp xs ys) x y+        (liftCompare . liftCompare) (\ (x, xs) (y, ys) -> cmp x y <> liftCompare cmp xs ys) x y  instance Show1 m => Show1 (ListT m) where     liftShowsPrec sp sl n (ListT x) = fst (show1Methods sp sl) n x@@ -38,7 +62,7 @@  show1Methods sp sl =     (l . l) (pure f,-             list id $+             list' id $              between '[' ']' . appEndo . intercalate (Endo (", " ++)) . fmap (Endo . f))   where l :: Show1 f => (Int -> a -> ShowS, [a] -> ShowS) -> (Int -> f a -> ShowS, [f a] -> ShowS)         l (sp, sl) = (liftShowsPrec sp sl, liftShowList sp sl)@@ -50,9 +74,7 @@  instance (Eq a, Eq1 m) => Eq (ListT m a) where (==) = liftEq (==) instance (Ord a, Ord1 m) => Ord (ListT m a) where compare = liftCompare compare-instance (Show a, Show1 m) => Show (ListT m a) where-    showsPrec = liftShowsPrec showsPrec showList-    showList = liftShowList showsPrec showList+instance (Show a, Show1 m) => Show (ListT m a) where showsPrec = showsPrec1  instance Applicative p => Applicative (ListT p) where     pure x = ListT . pure $ Just (x, ListT (pure Nothing))@@ -61,8 +83,9 @@  instance Applicative p => Alternative (ListT p) where     empty = (ListT . pure) Nothing-    ListT xm <|> ys = ListT ((fmap . fmap) go xm)-      where go (x, xs) = (x, xs <|> ys)+    ListT xm <|> ys@(ListT ym) = ListT (liftA2 go xm ym)+      where go = \ case Nothing -> id+                        Just (x, xs) -> pure $ Just (x, xs <|> ys)  instance Monad m => Monad (ListT m) where     xm >>= f = join (f <$> xm)@@ -82,10 +105,3 @@              id *** (pure . mfix $                      ListT <<< runListT . f >=> \ case Just (_, xs) -> runListT xs                                                        Nothing -> error "Nothing")--intercalate :: Semigroup a => a -> NonEmpty a -> a-intercalate a = sconcat . intersperse a--list :: b -> (NonEmpty a -> b) -> [a] -> b-list x _ [] = x-list _ f (x:xs) = f (x:|xs)

@@ -1,5 +1,5 @@ name:                ListT-version:             0.1.1.0+version:             0.1.2.0 synopsis:            List transformer -- description:          license:             BSD3@@ -20,7 +20,22 @@   -- other-extensions:       build-depends:       base >=4.9 && <5                      , transformers+                     , util >=0.1.4 && <0.2   -- hs-source-dirs:         default-language:    Haskell2010   default-extensions:  LambdaCase   ghc-options:         -Wall -Wno-name-shadowing++test-suite tests+  type:                exitcode-stdio-1.0+  main-is:             test.hs+  other-modules:       Test.List+  build-depends:       ListT+                     , base >=4.9 && <5+                     , smallcheck >=1.1.2 && <1.2+                     , tasty >=0.11 && <0.12+                     , tasty-smallcheck >=0.8.1 && <0.9+                     , transformers+                     , util >=0.1.4 && <0.2+  default-language:    Haskell2010+  default-extensions:  LambdaCase

@@ -0,0 +1,27 @@+{-# LANGUAGE TypeApplications #-}++module Test.List where++import Control.Applicative+import Control.Arrow+import Data.Function (on)+import Data.Functor.Identity+import qualified Data.List as L+import Numeric.Natural+import Test.SmallCheck+import Test.Tasty+import Test.Tasty.SmallCheck++import Control.Monad.Trans.List++tests :: TestTree+tests =+    testGroup "List"+    [testProperty "List = ListT Identity" $ changeDepth (min 4) $ \ (xs, ys) ->+     liftA2 (,) xs ys == (runIdentity . toListM $ (liftA2 (,) `on` fromList @_ @_ @Int) xs ys),+     testProperty "toListM" $ (==) <*> runIdentity . toListM . fromList @_ @_ @Int,+     testProperty "toReverseListM" $+     liftA2 (==) reverse $ runIdentity . toReverseListM . fromList @_ @_ @Int,+     testProperty "splitAtM" $ (liftA2 . liftA2) (==) L.genericSplitAt $ \ n ->+     runIdentity . splitAtM (n :: Natural) . fromList @_ @_ @Int >>>+     id *** runIdentity . toListM]

@@ -0,0 +1,8 @@+module Main where++import Test.Tasty++import qualified Test.List as L++main :: IO ()+main = defaultMain L.tests