packages feed

list-t 1.0.4 → 1.0.5

raw patch · 3 files changed

+210/−86 lines, 3 filesdep +logictdep ~HTFdep ~basedep ~semigroups

Dependencies added: logict

Dependency ranges changed: HTF, base, semigroups

Files

library/ListT.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE UndecidableInstances, CPP #-} module ListT (   ListT(..),@@ -7,6 +6,8 @@   head,   tail,   null,+  alternate,+  alternateHoisting,   fold,   foldMaybe,   applyFoldM,@@ -47,7 +48,49 @@ -- with it. newtype ListT m a =   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 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 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+  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+  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+  -- I wish I were joking.+  liftShowsPrec sp (sl :: [a] -> ShowS) = mark+    where+      bob :: Int -> m (Maybe (a, ListT m a)) -> ShowS+      bob = liftShowsPrec jill edith++      edith :: [Maybe (a, ListT m a)] -> ShowS+      edith = liftShowList jack martha++      jill :: Int -> Maybe (a, ListT m a) -> ShowS+      jill = liftShowsPrec jack martha++      martha :: [(a, ListT m a)] -> ShowS+      martha = liftShowList2 sp sl mark juan++      mark :: Int -> ListT m a -> ShowS+      mark d (ListT m) = showsUnaryWith bob "ListT" d m++      juan :: [ListT m a] -> ShowS+      juan = liftShowList sp sl++      jack :: Int -> (a, ListT m a) -> ShowS+      jack = liftShowsPrec2 sp sl mark juan+ instance Monad m => Semigroup (ListT m a) where   (<>) (ListT m1) (ListT m2) =     ListT $@@ -65,36 +108,46 @@   mappend = (<>)  instance Functor m => Functor (ListT m) where-  fmap f =-    ListT . (fmap . fmap) (f *** fmap f) . uncons+  fmap f = go+    where+      go =+        ListT . (fmap . fmap) (bimapPair' f go) . uncons  instance (Monad m, Functor m) => Applicative (ListT m) where   pure =      return   (<*>) =      ap+  -- This is just like liftM2, but it uses fmap over the second+  -- action. liftM2 can't do that, because it has to deal with+  -- the possibility that someone defines liftA2 = liftM2 and+  -- fmap f = (pure f <*>) (leaving (<*>) to the default).+  liftA2 f m1 m2 = do+    x1 <- m1+    fmap (f x1) m2+  (*>) = (>>)  instance (Monad m, Functor m) => Alternative (ListT m) where   empty = -    inline mzero+    inline mempty   (<|>) = -    inline mplus+    inline mappend  instance Monad m => Monad (ListT m) where   return a =     ListT $ return (Just (a, (ListT (return Nothing))))-  (>>=) s1 k2 =-    ListT $-      uncons s1 >>=-        \case-          Nothing ->-            return Nothing-          Just (h1, t1) ->-            uncons $ k2 h1 <> (t1 >>= k2)-#if !MIN_VERSION_base(4,11,0)-  fail _ =-    mempty-#endif+  -- We use a go function so GHC can inline k2+  -- if it likes.+  (>>=) s10 k2 = go s10+    where+      go s1 =+        ListT $+          uncons s1 >>=+            \case+              Nothing ->+                return Nothing+              Just (h1, t1) ->+                uncons $ k2 h1 <> go t1  instance Monad m => MonadFail (ListT m) where   fail _ =@@ -108,15 +161,16 @@  instance MonadTrans ListT where   lift =-    ListT . liftM (\a -> Just (a, mempty))+    ListT . fmap (\a -> Just (a, mempty))  instance MonadIO m => MonadIO (ListT m) where   liftIO =     lift . liftIO  instance MFunctor ListT where-  hoist f =-    ListT . f . (liftM . fmap) (id *** hoist f) . uncons+  hoist f = go+    where+      go = ListT . f . (fmap . fmap) (bimapPair' id go) . uncons  instance MMonad ListT where   embed f (ListT m) =@@ -143,7 +197,65 @@   throwError = ListT . throwError   catchError m handler = ListT $ catchError (uncons m) $ uncons . handler +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+  get = lift get+  put = lift . put+  state = lift . state++instance Monad m => MonadLogic (ListT m) where+  msplit (ListT m) = lift m++  interleave m1 m2 = ListT $ uncons m1 >>= \case+    Nothing -> uncons m2+    Just (a, m1') -> uncons $ cons a (interleave m2 m1')++  m >>- f = ListT $ uncons m >>= \case+    Nothing -> uncons empty+    Just (a, m') -> uncons $ interleave (f a) (m' >>- f)++  ifte t th el = ListT $ uncons t >>= \case+    Nothing -> uncons el+    Just (a,m) -> uncons $ th a <|> (m >>= th)++  once (ListT m) = ListT $ m >>= \case+    Nothing -> uncons empty+    Just (a, _) -> uncons (return a)++  lnot (ListT m) = ListT $ m >>= \case+    Nothing -> uncons (return ())+    Just _ -> uncons empty++instance MonadZip m => MonadZip (ListT m) where+  mzipWith f = go+    where+      go (ListT m1) (ListT m2) =+        ListT $ mzipWith (mzipWith $+                     \(a, as) (b, bs) -> (f a b, go as bs)) m1 m2++  munzip (ListT m)+    | (l, r) <- munzip (fmap go m)+    = (ListT l, ListT r)+    where+      go Nothing = (Nothing, Nothing)+      go (Just ((a, b), listab))+        = (Just (a, la), Just (b, lb))+        where+          -- If the underlying munzip is careful not to leak memory, then we+          -- don't want to defeat it.  We need to be sure that la and lb are+          -- realized as selector thunks.+          {-# NOINLINE remains #-}+          {-# NOINLINE la #-}+          {-# NOINLINE lb #-}+          remains = munzip listab+          (la, lb) = remains+ -- * Execution in the inner monad ------------------------- @@ -160,23 +272,45 @@ {-# INLINABLE head #-} head :: Monad m => ListT m a -> m (Maybe a) head =-  liftM (fmap fst) . uncons+  fmap (fmap fst) . uncons  -- | -- Execute, getting the tail. Returns nothing if it's empty. {-# INLINABLE tail #-} tail :: Monad m => ListT m a -> m (Maybe (ListT m a)) tail =-  liftM (fmap snd) . uncons+  fmap (fmap snd) . uncons  -- | -- Execute, checking whether it's empty. {-# INLINABLE null #-} null :: Monad m => ListT m a -> m Bool null =-  liftM (maybe True (const False)) . uncons+  fmap (maybe True (const False)) . uncons  -- |+-- Execute in the inner monad,+-- using its '(<|>)' function on each entry.+{-# INLINABLE alternate #-}+alternate :: (Alternative m, Monad m) => ListT m a -> m a+alternate (ListT m) = m >>= \case+  Nothing -> empty+  Just (a, as) -> pure a <|> alternate as++-- |+-- Use a monad morphism to convert a 'ListT' to a similar+-- monad, such as '[]'.+-- +-- A more efficient alternative to @'alternate' . 'hoist' f@.+{-# INLINABLE alternateHoisting #-}+alternateHoisting :: (Monad n, Alternative n) => (forall a. m a -> n a) -> ListT m a -> n a+alternateHoisting f = go+  where+    go (ListT m) = f m >>= \case+      Nothing -> empty+      Just (a, as) -> pure a <|> go as++-- | -- Execute, applying a left fold. {-# INLINABLE fold #-} fold :: Monad m => (r -> a -> m r) -> r -> ListT m a -> m r@@ -188,7 +322,7 @@ {-# INLINABLE foldMaybe #-} foldMaybe :: Monad m => (r -> a -> m (Maybe r)) -> r -> ListT m a -> m r foldMaybe s r l =-  liftM (maybe r id) $ runMaybeT $ do+  fmap (maybe r id) $ runMaybeT $ do     (h, t) <- MaybeT $ uncons l     r' <- MaybeT $ s r h     lift $ foldMaybe s r' t
library/ListT/Prelude.hs view
@@ -1,11 +1,12 @@ module ListT.Prelude (    module Exports,+  bimapPair',+  secondPair', ) where  import Control.Applicative as Exports-import Control.Arrow as Exports import Control.Category as Exports import Control.Concurrent as Exports import Control.Exception as Exports@@ -16,12 +17,15 @@ import Control.Monad.Fail as Exports import Control.Monad.Fix as Exports hiding (fix) import Control.Monad.IO.Class as Exports+import Control.Monad.Logic.Class as Exports import Control.Monad.Morph as Exports hiding (MonadTrans(..))+import Control.Monad.Reader.Class as Exports+import Control.Monad.State.Class as Exports import Control.Monad.ST as Exports import Control.Monad.Trans.Class as Exports import Control.Monad.Trans.Control as Exports hiding (embed, embed_) import Control.Monad.Trans.Maybe as Exports hiding (liftCatch, liftCallCC)-import Control.Monad.Trans.Reader as Exports hiding (liftCatch, liftCallCC)+import Control.Monad.Zip as Exports import Data.Bits as Exports import Data.Bool as Exports import Data.Char as Exports@@ -34,6 +38,7 @@ import Data.Foldable as Exports import Data.Function as Exports hiding (id, (.)) import Data.Functor as Exports+import Data.Functor.Classes as Exports import Data.Int as Exports import Data.IORef as Exports import Data.Ix as Exports@@ -75,3 +80,15 @@ import Text.Printf as Exports (printf, hPrintf) import Text.Read as Exports (Read(..), readMaybe, readEither) import Unsafe.Coerce as Exports++-- |+-- A slightly stricter version of Data.Bifunctor.bimap.+-- There's no benefit to producing lazy pairs here.+bimapPair' :: (a -> b) -> (c -> d) -> (a, c) -> (b, d)+bimapPair' f g = \(a,c) -> (f a, g c)++-- |+-- A slightly stricter version of Data.Bifunctor.second+-- that doesn't produce gratuitous lazy pairs.+secondPair' :: (b -> c) -> (a, b) -> (a, c)+secondPair' f = \(a,b) -> (a, f b)
list-t.cabal view
@@ -1,79 +1,52 @@-name:-  list-t-version:-  1.0.4-synopsis:-  ListT done right+name: list-t+version: 1.0.5+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-build-type:-  Simple-cabal-version:-  >=1.10-+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+build-type: Simple+cabal-version: >=1.10  source-repository head-  type:-    git-  location:-    git://github.com/nikita-volkov/list-t.git-+  type: git+  location: git://github.com/nikita-volkov/list-t.git  library-  hs-source-dirs:-    library+  hs-source-dirs: library+  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   exposed-modules:     ListT   other-modules:     ListT.Prelude   build-depends:+    base >=4.11 && <5,     foldl >=1 && <2,-    mmorph == 1.*,-    monad-control >= 0.3 && < 2,-    mtl == 2.*,-    transformers-base == 0.4.*,-    transformers >= 0.3 && < 0.6,-    base >= 4.9 && < 5-  if !impl(ghc >= 8.0)-    build-depends:-      semigroups >= 0.11 && < 0.19-  default-extensions:-    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, 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-  default-language:-    Haskell2010-+    logict >=0.7 && <0.8,+    mmorph ==1.*,+    monad-control >=0.3 && <2,+    mtl ==2.*,+    semigroups >=0.11 && <0.20,+    transformers >=0.3 && <0.6,+    transformers-base ==0.4.*  test-suite tests-  type:-    exitcode-stdio-1.0-  hs-source-dirs:-    tests-  main-is:-    Main.hs+  type: exitcode-stdio-1.0+  hs-source-dirs: tests+  main-is: Main.hs+  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   build-depends:     list-t,     mmorph,-    HTF == 0.13.*,-    mtl-prelude < 3,+    HTF >=0.13 && <0.15,+    mtl-prelude <3,     base-prelude-  default-extensions:-    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, 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-  default-language:-    Haskell2010