packages feed

list-t (empty) → 0.2.1

raw patch · 5 files changed

+481/−0 lines, 5 filesdep +HTFdep +base-preludedep +list-tsetup-changed

Dependencies added: HTF, base-prelude, list-t, mmorph, monad-control, mtl-prelude, transformers, transformers-base

Files

+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2014, Nikita Volkov++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ executables/APITests.hs view
@@ -0,0 +1,129 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}++import BasePrelude hiding (toList)+import MTLPrelude+import Test.Framework+import qualified ListT as L+++main = htfMain $ htf_thisModulesTests+++-- * 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+++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
@@ -0,0 +1,256 @@+{-# LANGUAGE UndecidableInstances #-}+module ListT+(+  ListT,+  -- * Classes+  ListTrans(..),+  ListMonad(..),+  -- * Execution utilities+  head,+  tail,+  null,+  fold,+  toList,+  traverse_,+  -- * Construction utilities+  fromFoldable,+  unfold,+  repeat,+  -- * Transformation utilities+  -- | +  -- These utilities only accumulate the transformations+  -- without actually traversing the stream.+  -- They only get applied with a single traversal, +  -- which happens at the execution.+  traverse,+  take,+)+where++import BasePrelude hiding (toList, yield, fold, traverse, head, tail, take, repeat, null, traverse_)+import Control.Monad.Morph+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Monad.Trans.Reader+import Control.Monad.Trans.Control+import Control.Monad.Base++-- |+-- A proper implementation of a list monad-transformer.+-- Useful for streaming of monadic data structures.+-- +-- Since it has instances of 'MonadPlus' and 'Alternative',+-- you can use general utilities packages like+-- <http://hackage.haskell.org/package/monadplus "monadplus">+-- with it.+newtype ListT m a =+  ListT (m (Maybe (a, ListT m a)))++instance Monad m => Monoid (ListT m a) where+  mempty =+    ListT $ +      return Nothing+  mappend (ListT m1) (ListT m2) =+    ListT $+      m1 >>=+        \case+          Nothing ->+            m2+          Just (h1, s1') ->+            return (Just (h1, (mappend s1' (ListT m2))))++instance Functor m => Functor (ListT m) where+  fmap f (ListT m) =+    ListT $ (fmap . fmap) (\(a, b) -> (f a, fmap f b)) m++instance (Monad m, Functor m) => Applicative (ListT m) where+  pure = +    return+  (<*>) = +    ap++instance (Monad m, Functor m) => Alternative (ListT m) where+  empty = +    inline mzero+  (<|>) = +    inline mplus++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)++instance Monad m => MonadPlus (ListT m) where+  mzero = +    inline mempty+  mplus = +    inline mappend++instance MonadTrans ListT where+  lift =+    ListT . liftM (\a -> Just (a, mempty))++instance MonadIO m => MonadIO (ListT m) where+  liftIO =+    lift . liftIO++instance MFunctor ListT where+  hoist f (ListT m) =+    ListT $ f $ m >>= return . fmap (\(h, t) -> (h, hoist f t))++instance MonadBase b m => MonadBase b (ListT m) where+  liftBase =+    lift . liftBase++instance MonadBaseControl b m => MonadBaseControl b (ListT m) where+  newtype StM (ListT m) a =+    StM (StM m (Maybe (a, ListT m a)))+  liftBaseWith runToBase =+    lift $ liftBaseWith $ \runInner -> +      runToBase $ liftM StM . runInner . uncons+  restoreM (StM inner) =+    lift (restoreM inner) >>= \case+      Nothing -> mzero+      Just (h, t) -> cons h t+++-- * Classes+-------------------------++-- |+-- A monad transformer capable of executing like a list.+class MonadTrans t => ListTrans t where+  -- |+  -- Execute in the inner monad,+  -- getting the head and the tail.+  -- Returns nothing if it's empty.+  uncons :: t m a -> m (Maybe (a, t m a))++instance ListTrans ListT where+  {-# INLINE uncons #-}+  uncons (ListT m) = m+++-- |+-- A monad capable of constructing like a list.+class MonadPlus m => ListMonad m where+  -- |+  -- Prepend an element.+  cons :: a -> m a -> m a++instance ListMonad [] where+  cons a m = a : m++instance Monad m => ListMonad (ListT m) where+  {-# INLINABLE cons #-}+  cons h t = ListT $ return (Just (h, t))++instance ListMonad m => ListMonad (ReaderT e m) where+  cons a m = ReaderT $ cons a . runReaderT m+++-- * Execution in the inner monad+-------------------------++-- |+-- Execute, getting the head. Returns nothing if it's empty.+{-# INLINABLE head #-}+head :: (Monad m, ListTrans t) => t m a -> m (Maybe a)+head =+  liftM (fmap fst) . uncons++-- |+-- Execute, getting the tail. Returns nothing if it's empty.+{-# INLINABLE tail #-}+tail :: (Monad m, ListTrans t) => t m a -> m (Maybe (t m a))+tail =+  liftM (fmap snd) . uncons++-- |+-- Execute, checking whether it's empty.+{-# INLINABLE null #-}+null :: (Monad m, ListTrans t) => t m a -> m Bool+null =+  liftM (maybe True (const False)) . uncons++-- |+-- Execute, applying a left fold.+{-# INLINABLE fold #-}+fold :: (Monad m, ListTrans t) => (r -> a -> m r) -> r -> t m a -> m r+fold s r = +  uncons >=> maybe (return r) (\(h, t) -> s r h >>= \r' -> fold s r' t)++-- |+-- Execute, folding to a list.+{-# INLINABLE toList #-}+toList :: (Monad m, ListTrans t) => t m a -> m [a]+toList =+  liftM ($ []) . fold (\f e -> return $ f . (e :)) id++-- |+-- Execute, traversing the stream with a side effect in the inner monad. +{-# INLINABLE traverse_ #-}+traverse_ :: (Monad m, ListTrans t) => (a -> m ()) -> t m a -> m ()+traverse_ f =+  fold (const f) ()+++-- * Construction+-------------------------++-- |+-- Construct from any foldable.+{-# INLINABLE fromFoldable #-}+fromFoldable :: (ListMonad m, Foldable f) => f a -> m a+fromFoldable = +  foldr cons mzero++-- |+-- Construct by unfolding a pure data structure.+{-# INLINABLE unfold #-}+unfold :: (ListMonad m) => (b -> Maybe (a, b)) -> b -> m a+unfold f s =+  maybe mzero (\(h, t) -> cons h (unfold f t)) (f s)++-- |+-- Produce an infinite stream.+{-# INLINABLE repeat #-}+repeat :: (ListMonad m) => a -> m a+repeat = +  fix . cons+++-- * Transformation+-------------------------++-- |+-- A lazy transformation,+-- which traverses the stream with an action in the inner monad.+{-# INLINABLE traverse #-}+traverse :: (Monad m, ListMonad (t m), ListTrans t) => (a -> m b) -> t m a -> t m b+traverse f s =+  lift (uncons s) >>= +  mapM (\(h, t) -> lift (f h) >>= \h' -> cons h' (traverse f t)) >>=+  maybe mzero return++-- |+-- A lazy trasformation, +-- reproducing the behaviour of @Data.List.'Data.List.take'@.+{-# INLINABLE take #-}+take :: (Monad m, ListMonad (t m), ListTrans t) => Int -> t m a -> t m a+take =+  \case+    n | n > 0 -> \t ->+      lift (uncons t) >>= +        \case+          Nothing -> t+          Just (h, t) -> cons h (take (pred n) t)+    _ ->+      const $ mzero
+ list-t.cabal view
@@ -0,0 +1,72 @@+name:+  list-t+version:+  0.2.1+synopsis:+  ListT done right+description:+  A correct implementation of the list monad-transformer.+  Useful for streaming of mutable datastructures.+category:+  Data Structures, Control, Monad, Data+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+++library+  hs-source-dirs:+    library+  other-modules:+  exposed-modules:+    ListT+  build-depends:+    mmorph == 1.0.*,+    monad-control == 0.3.*,+    transformers-base == 0.4.*,+    transformers == 0.4.*,+    base-prelude == 0.1.*+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+++test-suite api-tests+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    executables+  main-is:+    APITests.hs+  build-depends:+    list-t,+    HTF == 0.11.*,+    mtl-prelude == 0.1.*,+    base-prelude >= 0.1.3 && < 0.2+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010