arrow-list 0.2.0 → 0.6

raw patch · 7 files changed

+323/−12 lines, 7 filesdep +containersPVP ok

version bump matches the API change (PVP)

Dependencies added: containers

API changes (from Hackage documentation)

Files

• arrow-list.cabal +14/−9
• src/Control/Arrow/ArrowF.hs +173/−0
• src/Control/Arrow/ArrowKleisli.hs +14/−3
• src/Control/Arrow/ArrowList.hs +4/−0
• src/Control/Arrow/List.hs +6/−0
• src/Control/Arrow/Sequence.hs +48/−0
• src/Control/Monad/Sequence.hs +64/−0

@@ -1,12 +1,13 @@ Name:             arrow-list-Version:          0.2.0+Version:          0.6 Synopsis:         List arrows for Haskell. Description:      This small Haskell library provides some type class, types-                  and functions to work with list arrows. List arrows represent-                  computations that may return multiple outputs. Making-                  functions that return lists an instance of both the-                  `Category` and `Arrow` type class allow you to easily compose-                  multiple computations into one with standard building blocks.+                  and functions to work with list (and list-like) arrows. List+                  arrows represent computations that may return multiple+                  outputs. Making functions that return lists an instance of+                  both the `Category` and `Arrow` type class allow you to+                  easily compose multiple computations into one with standard+                  building blocks.  Category:         Control License:          BSD3@@ -20,10 +21,14 @@   GHC-Options:      -Wall   HS-Source-Dirs:   src -  Build-Depends:    base ==4.*,-                    mtl >= 1.1 && < 2.1+  Build-Depends:    base ==4.*+                  , mtl >= 1.1 && < 2.1+                  , containers >=0.3 && < 0.5 -  Exposed-modules:  Control.Arrow.ArrowKleisli+  Exposed-modules:  Control.Arrow.ArrowF+                    Control.Arrow.ArrowKleisli                     Control.Arrow.ArrowList                     Control.Arrow.List+                    Control.Arrow.Sequence+                    Control.Monad.Sequence 

@@ -0,0 +1,173 @@+{-# LANGUAGE+    TypeOperators+  , Arrows+  , MultiParamTypeClasses+  , FunctionalDependencies+  #-}+module Control.Arrow.ArrowF+(+  -- * Container arrow type class.+  ArrowF (..)+, mapF+, arrMF++  -- * Generic arrow utilities.+, unite+, const+, concatA+, plus++  -- * Container arrow utilities.+, constF+, none+, results++  -- * Conditional and filter arrows.+, isA+, ifA+, when+, guards+, filterA+, notA+, orElse++  -- * Optionality.+, maybeA+, optional+)+where++import Control.Applicative hiding (optional)+import Control.Arrow+import Control.Arrow.ArrowKleisli+import Control.Category+import Data.Foldable (Foldable, toList)+import Prelude hiding ((.), id, const)+import qualified Prelude++-- | A type class for arrows that produce containers of results. The container+-- arrow can be seen as a generalization for list arrows. Most operations+-- assume the container type has an 'Applicative', an 'Alternative' and a+-- 'Foldable' instance.++class Arrow (~>) => ArrowF f (~>) | (~>) -> f where+  embed   :: f a ~> a              -- ^ Use a container as the input for an arrow.+  observe :: (a ~> b) -> a ~> f b  -- ^ Get the result as container.++-- | Embed a monadic function returning an ordered list into a container arrow.++arrMF :: (ArrowF f (~>), ArrowKleisli m (~>)) => (a -> m (f c)) -> a ~> c+arrMF x = embed . arrM x++-- | Map a function over the result collection of a container arrow.++mapF :: ArrowF f (~>) => (f b -> f c) -> a ~> b -> a ~> c+mapF f a = embed . arr f . observe a++-- | Take the output of an arrow producing two results and concatenate them+-- into the result of the container arrow.++unite :: ArrowPlus (~>) => (b, b) ~> b+unite = arr fst <+> arr snd++-- | Skip the input and produce a constant output.++const :: Arrow (~>) => b -> a ~> b+const = arr . Prelude.const++-- | Collect the results of applying multiple arrows to the same input.++concatA :: ArrowPlus (~>) => [a ~> b] -> a ~> b+concatA = foldr (<+>) zeroArrow++-- | Join the results of two arrows, like (<+>) from ArrowPlus.++plus :: (Alternative f, ArrowF f (~>)) => (a ~> b) -> (a ~> b) -> a ~> b+plus a b = embed . arr (\(x, y) -> x <|> y) . (observe a &&& observe b)++-- | Skip the input and produce a constant output specified as a container.++constF :: ArrowF f (~>) => f c -> a ~> c+constF f = embed . const f++-- | Ignore the input and produce no results. Like `zeroArrow'.++none :: (Alternative f, ArrowF f (~>)) => a ~> b+none = constF empty++-- | Returns a `Bool' indicating whether the input arrow produces a container+-- with any results.++results :: (Foldable f, ArrowF f (~>)) => (a ~> b) -> (a ~> Bool)+results a = arr (not . null . toList) . observe a++-- | Create a filtering container arrow by mapping a predicate function over the+-- input. When the predicate returns `True' the input will be returned in the+-- output container, when `False' the empty container is returned.++isA :: (Alternative f, ArrowF f (~>)) => (a -> Bool) -> a ~> a+isA f = embed . arr (\a -> if f a then pure a else empty)++-- | Use the result of a container arrow as a conditional, like an if-then-else+-- arrow. When the first arrow produces any results the /then/ arrow will be+-- used, when the first arrow produces no results the /else/ arrow will be+-- used.++ifA :: (Foldable f, ArrowF f (~>), ArrowChoice (~>)) => (a ~> b) -> (a ~> t) -> (a ~> t) -> a ~> t+ifA c t e = proc i -> do x <- results c -< i; if x then t -< i else e -< i++-- | Apply a container arrow only when a conditional arrow produces any+-- results.  When the conditional produces no results the output arrow /behaves+-- like the identity/. The /second/ input arrow is used as the conditional,+-- this allow you to write: @ a \`when\` condition @++infix 7 `when`++when :: (Foldable f, ArrowF f (~>), ArrowChoice (~>)) => (a ~> a) -> (a ~> c) -> a ~> a+when a c = ifA c a id++-- | Apply a container arrow only when a conditional arrow produces any+-- results.  When the conditional produces no results the output arrow+-- /produces no results/. The /first/ input arrow is used as the conditional,+-- this allow you to write: @ condition \`guards\` a @++infix 8 `guards`++guards :: (Alternative f, Foldable f, ArrowF f (~>), ArrowChoice (~>)) => (a ~> c) -> (a ~> b) -> (a ~> b)+guards c a = ifA c a none++-- | Filter the results of an arrow with a predicate arrow, when the filter+-- condition produces results the input is accepted otherwise it is excluded.++filterA :: (Alternative f, Foldable f, ArrowF f (~>), ArrowChoice (~>)) => (a ~> c) -> a ~> a+filterA c = ifA c id none++-- | Negation container arrow. Only accept the input when the condition+-- produces no output.++notA :: (Alternative f, Foldable f, ArrowF f (~>), ArrowChoice (~>)) => (a ~> c) -> a ~> a+notA c = ifA c none id++-- | Apply the input arrow, when the arrow does not produces any results the+-- second fallback arrow is applied.+-- Likely written infix like this @ a \`orElse\` b @++infix 6 `orElse`++orElse :: (Foldable f, ArrowF f (~>), ArrowChoice (~>)) => (a ~> b) -> (a ~> b) -> a ~> b+orElse a = ifA a a ++-- | Map a `Maybe' input to a container output. When the Maybe is a `Nothing'+-- an empty container will be returned, `Just' will result in a singleton+-- container.++maybeA :: (Alternative f, ArrowF f (~>)) => Maybe a ~> a+maybeA = embed . arr (maybe empty pure)++-- | Apply a container arrow, when there are no results a `Nothing' will be+-- returned, otherwise the results will be wrapped in a `Just'. This function+-- always produces result.++optional :: (Foldable f, ArrowF f (~>), ArrowChoice (~>)) => (a ~> b) -> a ~> Maybe b+optional a = ifA a (arr Just . a) (arr (const Nothing))+

@@ -1,8 +1,7 @@ {- |-The `ArrowKleisli' typeclass allows for embedding monadic function in Kleisli-arrows.+The `ArrowKleisli' type class allows for embedding monadic operations in+Kleisli arrows. -}- {-# LANGUAGE     TypeOperators   , MultiParamTypeClasses@@ -12,10 +11,22 @@ module Control.Arrow.ArrowKleisli where  import Control.Arrow+import Control.Category+import Control.Monad.Trans+import Prelude hiding ((.), id)  class (Monad m, Arrow (~>)) => ArrowKleisli m (~>) | (~>) -> m where   arrM :: (a -> m b) -> a ~> b  instance Monad m => ArrowKleisli m (Kleisli m) where   arrM f = Kleisli f++constM :: ArrowKleisli m (~>) => m b -> a ~> b+constM a = arrM (const a)++effect :: ArrowKleisli m (~>) => m () -> a ~> a+effect a = arrM (\b -> a >> return b)++arrIO :: (MonadIO m, ArrowKleisli m (~>)) => (a -> IO b) -> a ~> b+arrIO f = arrM (liftIO . f) 

@@ -104,6 +104,8 @@ -- The /second/ input arrow is used as the conditional, this allow -- you to write: @ a \`when\` c @ +infix 8 `when`+ when :: (ArrowList (~>), ArrowChoice (~>))      => (a ~> a)  -- ^ The arrow to apply,      -> (a ~> b)  -- ^ when this conditional holds.@@ -138,6 +140,8 @@ -- | Apply the input arrow, when the arrow does not produces any results the -- second fallback arrow is applied. -- Likely written infix like this @ a \`orElse\` b @++infix 8 `orElse`  orElse :: (ArrowList (~>), ArrowChoice (~>)) => (a ~> b) -> (a ~> b) -> a ~> b orElse a = ifA a a 

@@ -11,6 +11,7 @@ import Control.Arrow import Control.Arrow.ArrowKleisli import Control.Arrow.ArrowList+import Control.Arrow.ArrowF import Control.Category import Control.Monad.Identity import Control.Monad.List@@ -43,6 +44,11 @@ instance Monad m => ArrowList (ListTArrow m) where   arrL a   = ListTArrow (Kleisli (ListT . return . a))   mapL f g = arrML (liftM f . runListTArrow g)++instance Monad m => ArrowF [] (ListTArrow m) where+  embed     = ListTArrow (Kleisli (ListT . return))+  observe f = ListTArrow . Kleisli $ \a -> ListT $+                return `liftM` runListT (runKleisli (runListTArrow' f) a)  -- * Embed a monadic function returning lists. 

@@ -0,0 +1,48 @@+{-# LANGUAGE+    GeneralizedNewtypeDeriving+  , TypeOperators+  , FlexibleInstances+  , MultiParamTypeClasses+  , StandaloneDeriving+  #-}+module Control.Arrow.Sequence where++import Control.Arrow+import Control.Arrow.ArrowF+import Control.Arrow.ArrowKleisli+import Control.Category+import Control.Monad.Identity+import Control.Monad.Sequence+import Data.Sequence+import Prelude hiding ((.), id, const)++-- * SeqT arrow.++newtype SeqTArrow m a b = SeqTArrow { runSeqTArrow' :: Kleisli (SeqT m) a b }+  deriving+    ( Category+    , Arrow+    , ArrowZero+    , ArrowPlus+    , ArrowApply+    , ArrowChoice+    )++instance Monad m => ArrowKleisli m (SeqTArrow m) where+  arrM a = SeqTArrow (Kleisli (SeqT . (liftM return . a)))++runSeqTArrow :: SeqTArrow m a b -> a -> m (Seq b)+runSeqTArrow a = runSeqT . runKleisli (runSeqTArrow' a)++-- * Seq arrow.++type SeqArrow a b = SeqTArrow Identity a b++runSeqArrow :: SeqArrow a b -> a -> Seq b+runSeqArrow a = runIdentity . runSeqTArrow a++instance Monad m => ArrowF Seq (SeqTArrow m) where+  embed     = SeqTArrow (Kleisli (SeqT . return))+  observe f = SeqTArrow . Kleisli $ \a -> SeqT $+                singleton `liftM` runSeqT (runKleisli (runSeqTArrow' f) a)+

@@ -0,0 +1,64 @@+{-# OPTIONS -fno-warn-orphans #-}+module Control.Monad.Sequence+(+-- * The `Sequence' monad transformer.+  SeqT (..)+)+where++import Control.Applicative+import Control.Monad hiding (mapM, msum)+import Control.Monad.Trans+import Data.Foldable+import Data.Monoid+import Data.Sequence+import Data.Traversable+import Prelude hiding (mapM)++instance Applicative Seq where+  pure  = return+  (<*>) = ap++instance Alternative Seq where+  empty = mzero+  (<|>) = mplus++-- | Parameterizable `Sequence' monad, with an inner monad. The semantics of+-- `SeqT' are comparable to that of `ListT`.+--+-- /Note:/ Like the ListT monad, this does not yield a monad unless the+-- argument monad is commutative.+newtype SeqT m a = SeqT { runSeqT :: m (Seq a) }++mapSeqT :: (m (Seq a) -> n (Seq b)) -> SeqT m a -> SeqT n b+mapSeqT f = SeqT . f . runSeqT++instance Functor m => Functor (SeqT m) where+  fmap = mapSeqT . fmap . fmap++instance Applicative m => Applicative (SeqT m) where+  pure    = SeqT . pure . return+  a <*> b = SeqT (ap <$> runSeqT a <*> runSeqT b)++instance Applicative m => Alternative (SeqT m) where+  empty   = SeqT (pure mempty)+  a <|> b = SeqT (mappend <$> runSeqT a <*> runSeqT b)++instance Monad m => Monad (SeqT m) where+  return  = SeqT . return . return+  m >>= k = SeqT $+    do a <- runSeqT m+       b <- mapM (runSeqT . k) a+       return (msum b)+  fail _ = SeqT (return mempty)++instance Monad m => MonadPlus (SeqT m) where+  mzero       = SeqT (return mempty)+  m `mplus` n = SeqT (liftM2 mappend (runSeqT m) (runSeqT n))++instance MonadTrans SeqT where+  lift m = SeqT (liftM return m)++instance MonadIO m => MonadIO (SeqT m) where+  liftIO = lift . liftIO+