monad-skeleton 0.1.4 → 0.1.5

raw patch · 7 files changed

+62/−69 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• README.md +1/−1
• monad-skeleton.cabal +2/−2
• src/Control/Monad/Skeleton.hs +14/−0
• src/Control/Monad/Skeleton/Internal.hs +1/−1
• src/Control/Monad/Zombie.hs +36/−28
• src/Control/Monad/Zombie/Internal.hs +0/−37

@@ -0,0 +1,8 @@+0.1.5+----+* Changed the representation of `Zombie` too+* Added `deboneBy`++0.1.4+----+* Changed the representation of `Skeleton` for performance optimisation

@@ -2,7 +2,7 @@ ======================  [![Build Status](https://travis-ci.org/fumieval/monad-skeleton.svg?branch=master)](https://travis-ci.org/fumieval/monad-skeleton)-[![Hackage](https://budueba.com/hackage/monad-skeleton)](https://hackage.haskell.org/package/monad-skeleton)+[![Hackage](https://img.shields.io/hackage/v/monad-skeleton.svg)](https://hackage.haskell.org/package/monad-skeleton)  This package provides `Skeleton`, an operational monad. The internal encoding gives O(1) bind and monadic reflection.

@@ -1,5 +1,5 @@ name:                monad-skeleton-version:             0.1.4+version:             0.1.5 synopsis:            Monads of program skeleta description:         Fast operational monad library homepage:            https://github.com/fumieval/monad-skeleton@@ -16,6 +16,7 @@   .travis.yml   .gitignore   README.md+  CHANGELOG.md tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2  source-repository head@@ -26,7 +27,6 @@   exposed-modules:     Control.Monad.Skeleton     , Control.Monad.Skeleton.Internal     , Control.Monad.Zombie-    , Control.Monad.Zombie.Internal   build-depends:       base == 4.*   hs-source-dirs: src   ghc-options: -Wall

@@ -5,6 +5,7 @@   , Skeleton(..)   , bone   , debone+  , deboneBy   , unbone   , boned   , hoistSkeleton@@ -30,6 +31,19 @@   go c a = viewL c (\(Kleisli k) -> k a) $ \(Kleisli k) c' -> case k a of     ReturnS b -> go c' b     BindS t' c'' -> BindS t' (Tree c'' c')++-- | Pick a bone from a 'Skeleton' by a function.+-- It's useful when used with @LambdaCase@.+--+-- Usecase:+--+-- >  interpretM :: Monad m => Skeleton m a -> m a+-- >  interpretM = deboneBy $ \case+-- >    Return a -> return a+-- >    x :>>= f -> x >>= interpretM . f+deboneBy :: (MonadView t (Skeleton t) a -> r) -> Skeleton t a -> r+deboneBy f s = f (debone s)+{-# INLINE deboneBy #-}  -- | Uncommon synonym for 'debone'. unbone :: Skeleton t a -> MonadView t (Skeleton t) a

@@ -22,7 +22,7 @@   -> (forall x. k a x -> Cat k x b -> r)   -> r viewL (Leaf k) e _ = e k-viewL (Tree a b) e r = go a b where+viewL (Tree a b) _ r = go a b where   go :: Cat k a x -> Cat k x b -> r   go (Leaf k) t = r k t   go (Tree c d) t = go c (Tree d t)

@@ -1,25 +1,22 @@ {-# LANGUAGE Rank2Types, ScopedTypeVariables, GADTs #-}-module Control.Monad.Zombie where+module Control.Monad.Zombie (Zombie(..)+  , liftZ+  , embalm+  , disembalm+  , hoistZombie+  ) where import Control.Applicative import Control.Arrow-import Control.Category import Control.Monad import Control.Monad.Skeleton-import Control.Monad.Skeleton.Internal (transKleisli)-import Control.Monad.Zombie.Internal+import Control.Monad.Skeleton.Internal import Prelude hiding (id, (.)) --- | The spine of skeleta.-data Spine t m a where-  Spine :: MonadView t m a -> Cat (Kleisli m) a b -> Spine t m b---- | Extend a spine.-graftSpine :: Cat (Kleisli m) a b -> Spine t m a -> Spine t m b-graftSpine c (Spine v d) = Spine v (Tree d c)-{-# INLINE graftSpine #-}- -- | 'Zombie' is a variant of 'Skeleton' which has an 'Alternative' instance.-newtype Zombie t a = Zombie { unZombie :: [Spine t (Zombie t) a] }+data Zombie t a where+  Sunlight :: Zombie t a+  ReturnZ :: a -> Zombie t a -> Zombie t a+  BindZ :: t x -> Cat (Kleisli (Zombie t)) x a -> Zombie t a -> Zombie t a  instance Functor (Zombie t) where   fmap = liftM@@ -30,12 +27,16 @@   (*>) = (>>)  instance Alternative (Zombie t) where-  empty = Zombie []-  Zombie xs <|> Zombie ys = Zombie (xs ++ ys)+  empty = Sunlight+  Sunlight <|> ys = ys+  ReturnZ x xs <|> ys = ReturnZ x (xs <|> ys)+  BindZ x c xs <|> ys = BindZ x c (xs <|> ys)  instance Monad (Zombie t) where-  return a = Zombie [Spine (Return a) id]-  Zombie xs >>= k = Zombie $ map (graftSpine $ Leaf $ Kleisli k) xs+  return a = ReturnZ a Sunlight+  Sunlight >>= _ = Sunlight+  ReturnZ a xs >>= k = k a <|> (xs >>= k)+  BindZ x c xs >>= k = BindZ x (c |> Kleisli k) (xs >>= k)  instance MonadPlus (Zombie t) where   mzero = empty@@ -48,23 +49,30 @@  -- | Turn a decomposed form into a composed form. embalm :: MonadView t (Zombie t) a -> Zombie t a-embalm t = Zombie [Spine t id]+embalm (Return x) = ReturnZ x Sunlight+embalm (x :>>= k) = BindZ x (Leaf $ Kleisli k) Sunlight {-# INLINE embalm #-}  -- | Decompose a zombie as a list of possibilities. disembalm :: Zombie t a -> [MonadView t (Zombie t) a]-disembalm (Zombie ss) = do-  Spine v c <- ss-  case v of-    Return a -> viewL c [Return a] $ \(Kleisli k) c' -> case k a of-      Zombie ss' -> disembalm $ Zombie $ map (graftSpine c') ss'-    t :>>= k -> return $ t :>>= \a -> case k a of-      Zombie ss' -> Zombie $ map (graftSpine c) ss'+disembalm Sunlight = []+disembalm (ReturnZ x xs) = Return x : disembalm xs+disembalm (BindZ x d xs) = (x :>>= disembalm_go d) : disembalm xs +disembalm_go :: Cat (Kleisli (Zombie t)) a b -> a -> Zombie t b+disembalm_go c a = viewL c (\(Kleisli k) -> k a) $ \(Kleisli k) c' -> disembalm_go2 (k a) c'++disembalm_go2 :: Zombie t a -> Cat (Kleisli (Zombie t)) a b -> Zombie t b+disembalm_go2 x c = case x of+  Sunlight -> Sunlight+  ReturnZ a xs -> disembalm_go c a <|> disembalm_go2 xs c+  BindZ t c' xs -> BindZ t (Tree c' c) $ disembalm_go2 xs c+ -- | Like 'hoistSkeleton' hoistZombie :: forall s t a. (forall x. s x -> t x) -> Zombie s a -> Zombie t a hoistZombie f = go where   go :: forall x. Zombie s x -> Zombie t x-  go (Zombie ss) = Zombie [Spine (hoistMV f go v) (transCat (transKleisli go) c)-    | Spine v c <- ss]+  go Sunlight = Sunlight+  go (ReturnZ x xs) = ReturnZ x (go xs)+  go (BindZ x c xs) = BindZ (f x) (transCat (transKleisli go) c) (go xs) {-# INLINE hoistZombie #-}

@@ -1,37 +0,0 @@-{-# LANGUAGE PolyKinds, GADTs, Rank2Types, ScopedTypeVariables, Trustworthy #-}-module Control.Monad.Zombie.Internal (Cat(..), transCat, (|>), viewL) where--import Control.Category--data Cat k a b where-  Empty :: Cat k a a-  Leaf :: k a b -> Cat k a b-  Tree :: Cat k a b -> Cat k b c -> Cat k a c--transCat :: (forall x y. j x y -> k x y) -> Cat j a b -> Cat k a b-transCat f (Tree a b) = transCat f a `Tree` transCat f b-transCat f (Leaf k) = Leaf (f k)-transCat _ Empty = Empty-{-# INLINE transCat #-}--(|>) :: Cat k a b -> k b c -> Cat k a c-s |> k = Tree s (Leaf k)-{-# INLINE (|>) #-}--viewL :: forall k a b r. Cat k a b-  -> ((a ~ b) => r)-  -> (forall x. k a x -> Cat k x b -> r)-  -> r-viewL Empty e _ = e-viewL (Leaf k) _ r = k `r` Empty-viewL (Tree a b) e r = go a b where-  go :: Cat k a x -> Cat k x b -> r-  go Empty t = viewL t e r-  go (Leaf k) t = r k t-  go (Tree c d) t = go c (Tree d t)--instance Category (Cat k) where-  id = Empty-  {-# INLINE id #-}-  (.) = flip Tree-  {-# INLINE (.) #-}