monad-skeleton 0.1.2.2 → 0.1.3

raw patch · 6 files changed

+249/−190 lines, 6 filesdep −containersdep −ghc-primsetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: containers, ghc-prim

API changes (from Hackage documentation)

Files

• LICENSE +30/−30
• Setup.hs +2/−2
• monad-skeleton.cabal +27/−26
• src/Control/Monad/Skeleton.hs +113/−100
• src/Control/Monad/Skeleton/Internal.hs +36/−32
• src/Control/Monad/Zombie.hs +41/−0

@@ -1,30 +1,30 @@-Copyright (c) 2015, Fumiaki Kinoshita
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-    * Redistributions of source code must retain the above copyright
-      notice, this list of conditions and the following disclaimer.
-
-    * Redistributions in binary form must reproduce the above
-      copyright notice, this list of conditions and the following
-      disclaimer in the documentation and/or other materials provided
-      with the distribution.
-
-    * Neither the name of Fumiaki Kinoshita nor the names of other
-      contributors may be used to endorse or promote products derived
-      from this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+Copyright (c) 2015, Fumiaki Kinoshita++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Fumiaki Kinoshita nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -1,2 +1,2 @@-import Distribution.Simple
-main = defaultMain
+import Distribution.Simple+main = defaultMain

@@ -1,26 +1,27 @@-name:                monad-skeleton
-version:             0.1.2.2
-synopsis:            An undead monad
-description:         A simple operational monad based on Reflection without Remorse
-homepage:            https://github.com/fumieval/monad-skeleton
-bug-reports:         http://github.com/fumieval/monad-skeleton/issues
-license:             BSD3
-license-file:        LICENSE
-author:              Fumiaki Kinoshita
-maintainer:          Fumiaki Kinoshita <fumiexcel@gmail.com>
-copyright:           Copyright (c) 2015 Fumiaki Kinoshita
-category:            Control
-build-type:          Simple
--- extra-source-files:
-cabal-version:       >=1.10
-
-source-repository head
-  type: git
-  location: https://github.com/fumieval/monad-skeleton.git
-
-library
-  exposed-modules:     Control.Monad.Skeleton, Control.Monad.Skeleton.Internal
-  build-depends:       base == 4.*, containers, ghc-prim
-  hs-source-dirs: src
-  ghc-options: -Wall
-  default-language:    Haskell2010
+name:                monad-skeleton+version:             0.1.3+synopsis:            Monads of program skeleta+description:         Fast operational monad library+homepage:            https://github.com/fumieval/monad-skeleton+bug-reports:         http://github.com/fumieval/monad-skeleton/issues+license:             BSD3+license-file:        LICENSE+author:              Fumiaki Kinoshita+maintainer:          Fumiaki Kinoshita <fumiexcel@gmail.com>+copyright:           Copyright (c) 2017 Fumiaki Kinoshita+category:            Control, Monads+build-type:          Simple+cabal-version:       >=1.10++source-repository head+  type: git+  location: https://github.com/fumieval/monad-skeleton.git++library+  exposed-modules:     Control.Monad.Skeleton+    , Control.Monad.Skeleton.Internal+    , Control.Monad.Zombie+  build-depends:       base == 4.*+  hs-source-dirs: src+  ghc-options: -Wall+  default-language:    Haskell2010

@@ -1,100 +1,113 @@-{-# LANGUAGE Trustworthy, RankNTypes, GADTs, ScopedTypeVariables #-}
-module Control.Monad.Skeleton (MonadView(..)
-  , hoistMV
-  , iterMV
-  , Skeleton(..)
-  , bone
-  , debone
-  , unbone
-  , boned
-  , hoistSkeleton
-  ) where
-import Control.Arrow
-import Control.Applicative
-import Control.Monad
-import Control.Category
-import Unsafe.Coerce
-import Control.Monad.Skeleton.Internal
-import Prelude hiding (id, (.))
-
--- | Re-add a bone.
-boned :: MonadView t (Skeleton t) a -> Skeleton t a
-boned t = Skeleton (Spine t id)
-{-# INLINE boned #-}
-
--- | Pick a bone from a 'Skeleton'.
-debone :: Skeleton t a -> MonadView t (Skeleton t) a
-debone (Skeleton (Spine (Return a) s)) = viewL s (Return a) $ \(Kleisli k) c -> case k a of
-  Skeleton (Spine h t) -> debone $ Skeleton $ Spine h (c . t)
-debone (Skeleton (Spine (t :>>= k) s)) = t :>>= \a -> case k a of
-  Skeleton (Spine h c) -> Skeleton (Spine h (s . c))
-
--- | Uncommon synonym for 'debone'.
-unbone :: Skeleton t a -> MonadView t (Skeleton t) a
-unbone = debone
-{-# INLINE unbone #-}
-
--- | A skeleton that has only one bone.
-bone :: t a -> Skeleton t a
-bone t = Skeleton (Spine (t :>>= return) id)
-{-# INLINABLE bone #-}
-
--- | Lift a transformation between bones into transformation between skeletons.
-hoistSkeleton :: forall s t a. (forall x. s x -> t x) -> Skeleton s a -> Skeleton t a
-hoistSkeleton f = go where
-  go :: forall x. Skeleton s x -> Skeleton t x
-  go (Skeleton (Spine v c)) = Skeleton $ Spine (hoistMV f go v)
-    (transCat (transKleisli go) c)
-{-# INLINE hoistSkeleton #-}
-
-data MonadView t m x where
-  Return :: a -> MonadView t m a
-  (:>>=) :: t a -> (a -> m b) -> MonadView t m b
-infixl 1 :>>=
-
-instance Functor m => Functor (MonadView t m) where
-  fmap f (Return a) = Return (f a)
-  fmap f (t :>>= k) = t :>>= fmap f . k
-  {-# INLINE fmap #-}
-
-hoistMV :: (forall x. s x -> t x) -> (m a -> n a) -> MonadView s m a -> MonadView t n a
-hoistMV _ _ (Return a) = Return a
-hoistMV f g (t :>>= k) = f t :>>= g . k
-{-# INLINE hoistMV #-}
-
-iterMV :: Monad m => (t a -> MonadView m t a) -> t a -> m a
-iterMV f = go where
-  go t = case f t of
-    m :>>= k -> m >>= go . k
-    Return a -> return a
-{-# INLINE iterMV #-}
-
-data Spine t m a where
-  Spine :: !(MonadView t m a) -> !(Cat (Kleisli m) a b) -> Spine t m b
-
--- | @'Skeleton' t@ is a monadic skeleton (operational monad) made out of 't'.
--- Skeletons can be fleshed out by getting transformed to other monads.
--- The implementation is based on
--- <http://wwwhome.cs.utwente.nl/~jankuper/fp-dag/pref.pdf Reflection without Remorse>
--- so it provides efficient ('>>=') and 'debone', monadic reflection.
-newtype Skeleton t a = Skeleton { unSkeleton :: Spine t (Skeleton t) a }
-
-instance Functor (Skeleton t) where
-  fmap = liftM
-  {-# INLINE fmap #-}
-
-instance Applicative (Skeleton t) where
-  pure = return
-  {-# INLINE pure #-}
-  (<*>) = ap
-  {-# INLINE (<*>) #-}
-
-instance Monad (Skeleton t) where
-  return a = Skeleton $ Spine (Return a) id
-  {-# INLINE return #-}
-  Skeleton (Spine t c) >>= k = Skeleton $ Spine t (c |> Kleisli k)
-  {-# INLINE (>>=) #-}
-
-transKleisli :: (m b -> n b) -> Kleisli m a b -> Kleisli n a b
-transKleisli f = unsafeCoerce (f.)
-{-# INLINE transKleisli #-}
+{-# LANGUAGE BangPatterns, Trustworthy, RankNTypes, GADTs, ScopedTypeVariables #-}+module Control.Monad.Skeleton (MonadView(..)+  , hoistMV+  , iterMV+  , Skeleton(..)+  , bone+  , debone+  , unbone+  , boned+  , hoistSkeleton+  -- * internal+  , Spine(..)+  , graftSpine+  ) where+import Control.Arrow+import Control.Applicative+import Control.Monad+import Control.Category+import Unsafe.Coerce+import Control.Monad.Skeleton.Internal+import Prelude hiding (id, (.))++-- | Re-add a bone.+boned :: MonadView t (Skeleton t) a -> Skeleton t a+boned t = Skeleton (Spine t id)+{-# INLINE boned #-}++-- | Pick a bone from a 'Skeleton'.+debone :: Skeleton t a -> MonadView t (Skeleton t) a+debone (Skeleton (Spine v c)) = case v of+  Return a -> viewL c (Return a) $ \(Kleisli k) c' -> case k a of+    Skeleton s -> debone $ Skeleton $ graftSpine c' s+  t :>>= k -> t :>>= \a -> case k a of+    Skeleton s -> Skeleton (graftSpine c s)++-- | Uncommon synonym for 'debone'.+unbone :: Skeleton t a -> MonadView t (Skeleton t) a+unbone = debone+{-# INLINE unbone #-}+{-# DEPRECATED unbone "Use debone instead" #-}++-- | A skeleton that has only one bone.+bone :: t a -> Skeleton t a+bone t = Skeleton (Spine (t :>>= return) id)+{-# INLINABLE bone #-}++-- | Lift a transformation between bones into transformation between skeletons.+hoistSkeleton :: forall s t a. (forall x. s x -> t x) -> Skeleton s a -> Skeleton t a+hoistSkeleton f = go where+  go :: forall x. Skeleton s x -> Skeleton t x+  go (Skeleton (Spine v c)) = Skeleton $ Spine (hoistMV f go v)+    (transCat (transKleisli go) c)+{-# INLINE hoistSkeleton #-}++-- | A deconstructed action+data MonadView t m x where+  Return :: a -> MonadView t m a+  (:>>=) :: !(t a) -> (a -> m b) -> MonadView t m b+infixl 1 :>>=++instance Functor m => Functor (MonadView t m) where+  fmap f (Return a) = Return (f a)+  fmap f (t :>>= k) = t :>>= fmap f . k+  {-# INLINE fmap #-}++-- | Transform the action and the continuation.+hoistMV :: (forall x. s x -> t x) -> (m a -> n a) -> MonadView s m a -> MonadView t n a+hoistMV _ _ (Return a) = Return a+hoistMV f g (t :>>= k) = f t :>>= g . k+{-# INLINE hoistMV #-}++-- | Join 'MonadView' recursively.+iterMV :: Monad m => (t a -> MonadView m t a) -> t a -> m a+iterMV f = go where+  go t = case f t of+    m :>>= k -> m >>= go . k+    Return a -> return a+{-# INLINE iterMV #-}++-- | 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 (c . d)+{-# INLINE graftSpine #-}++-- | @'Skeleton' t@ is a monadic skeleton (operational monad) made out of 't'.+-- Skeletons can be fleshed out by getting transformed to other monads.+-- It provides O(1) ('>>=') and 'debone', the monadic reflection.+newtype Skeleton t a = Skeleton { unSkeleton :: Spine t (Skeleton t) a }++instance Functor (Skeleton t) where+  fmap = liftM+  {-# INLINE fmap #-}++instance Applicative (Skeleton t) where+  pure = return+  {-# INLINE pure #-}+  (<*>) = ap+  {-# INLINE (<*>) #-}+  (*>) = (>>)+  {-# INLINE (*>) #-}+  a <* b = a >>= \x -> b >> return x++instance Monad (Skeleton t) where+  return a = Skeleton $ Spine (Return a) id+  Skeleton (Spine t c) >>= k = Skeleton $ Spine t (c |> Kleisli k)++transKleisli :: (m b -> n b) -> Kleisli m a b -> Kleisli n a b+transKleisli f = unsafeCoerce (f.)+{-# INLINE transKleisli #-}

@@ -1,33 +1,37 @@-{-# LANGUAGE PolyKinds, GADTs, Rank2Types #-}
-module Control.Monad.Skeleton.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 :: 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 = viewL a (viewL b e r) $ \k t -> k `r` Tree t b
-
-instance Category (Cat k) where
-  id = Empty
-  {-# INLINE id #-}
-  (.) = flip Tree
+{-# LANGUAGE PolyKinds, GADTs, Rank2Types, ScopedTypeVariables #-}+module Control.Monad.Skeleton.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 (.) #-}

@@ -0,0 +1,41 @@+module Control.Monad.Zombie where+import Control.Applicative+import Control.Arrow+import Control.Category+import Control.Monad+import Control.Monad.Skeleton+import Control.Monad.Skeleton.Internal+import Prelude hiding (id, (.))++-- | 'Zombie' is a variant of 'Skeleton' which has an 'Alternative' instance.+newtype Zombie t a = Zombie { unZombie :: [Spine t (Zombie t) a] }++instance Functor (Zombie t) where+  fmap = liftM++instance Applicative (Zombie t) where+  pure = return+  (<*>) = ap+  (*>) = (>>)++instance Alternative (Zombie t) where+  empty = Zombie []+  Zombie xs <|> Zombie ys = Zombie (xs ++ ys)++instance Monad (Zombie t) where+  return a = Zombie [Spine (Return a) id]+  Zombie xs >>= k = Zombie $ map (graftSpine $ Leaf $ Kleisli k) xs++-- | Turn a decomposed form into a composed form.+embalm :: MonadView t (Zombie t) a -> Zombie t a+embalm t = Zombie [Spine t id]++-- | 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'