monad-skeleton (empty) → 0

raw patch · 4 files changed

+122/−0 lines, 4 filesdep +basedep +containersdep +ghc-primsetup-changed

Dependencies added: base, containers, ghc-prim

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• monad-skeleton.cabal +25/−0
• src/Control/Monad/Skeleton.hs +65/−0

@@ -0,0 +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.

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

@@ -0,0 +1,25 @@+name:                monad-skeleton
+version:             0
+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
+  build-depends:       base == 4.*, containers, ghc-prim
+  hs-source-dirs: src
+  default-language:    Haskell2010

@@ -0,0 +1,65 @@+{-# LANGUAGE RankNTypes, GADTs, PolyKinds #-}+module Control.Monad.Skeleton (Skeleton, MonadView(..), bone, unbone) where+import qualified Data.Sequence as Seq+import Unsafe.Coerce+import Control.Category+import Control.Arrow+import Control.Applicative+import Control.Monad+import GHC.Prim+import Prelude hiding (id, (.))++unbone :: Skeleton t a -> MonadView t (Skeleton t) a+unbone (Skeleton (Return a) s) = case viewL s of+  Empty -> Return a+  Kleisli k :| c -> case k a of+    Skeleton h t -> unbone $ Skeleton h (c . t)+unbone (Skeleton (t :>>= k) s) = t :>>= \a -> case k a of+  Skeleton h t -> Skeleton h (s . t)++bone :: t a -> Skeleton t a+bone t = Skeleton (t :>>= return) id++data MonadView t m x where+  Return :: a -> MonadView t m a+  (:>>=) :: t a -> (a -> m b) -> MonadView t m b++data Skeleton t a where+  Skeleton :: MonadView t (Skeleton t) x -> Cat (Kleisli (Skeleton t)) x a -> Skeleton t a++newtype Cat k a b = Cat (Seq.Seq Any)++data View j k a b where+  Empty :: View j k a a+  (:|) :: j a b -> k b c -> View j k a c++(|>) :: Cat k a b -> k b c -> Cat k a c+Cat s |> k = Cat (s Seq.|> unsafeCoerce k)+{-# INLINE (|>) #-}++viewL :: Cat k a b -> View k (Cat k) a b+viewL (Cat s) = case Seq.viewl s of+  Seq.EmptyL -> unsafeCoerce Empty+  a Seq.:< b -> unsafeCoerce (:|) a b++instance Category (Cat k) where+  id = Cat Seq.empty+  {-# INLINE id #-}+  Cat a . Cat b = Cat (b Seq.>< a)+  {-# INLINE (.) #-}++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 (Return a) id+  {-# INLINE return #-}+  Skeleton t c >>= k = Skeleton t (c |> Kleisli k)+  {-# INLINE (>>=) #-}