packages feed

operational-alacarte (empty) → 0.1

raw patch · 6 files changed

+552/−0 lines, 6 filesdep +basedep +mtldep +operational-alacartesetup-changed

Dependencies added: base, mtl, operational-alacarte

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Anders Persson, Emil Axelsson, Markus Aronsson++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 Anders Persson, Emil Axelsson, Markus Aronsson 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/Simple.hs view
@@ -0,0 +1,114 @@+{-# OPTIONS_GHC -fno-warn-missing-methods #-}++import Data.IORef++import Control.Monad.Operational.Higher++++--------------------------------------------------------------------------------+-- Simple expression language+--------------------------------------------------------------------------------++data Exp a+  where+    Lit :: a -> Exp a+    Add :: Num a => Exp a -> Exp a -> Exp a+    Eq  :: Eq a => Exp a -> Exp a -> Exp Bool++instance Num a => Num (Exp a)+  where+    fromInteger = Lit . fromInteger+    (+) = Add++eval :: Exp a -> a+eval (Lit i)   = i+eval (Add a b) = eval a + eval b+eval (Eq a b)  = eval a == eval b++++--------------------------------------------------------------------------------+-- Composable instructions+--------------------------------------------------------------------------------++-- | If statement+data If p a+  where+    If :: Exp Bool -> p a -> p a -> If p a++-- | Loop+data Loop p a+  where+    Loop :: Exp Int -> p () -> Loop p ()++-- | Mutable references+data Ref (p :: * -> *) a+  where+    NewRef :: Exp a -> Ref p (IORef a)+    GetRef :: IORef a -> Ref p (Exp a)+    SetRef :: IORef a -> Exp a -> Ref p ()++instance HFunctor If+  where+    hfmap f (If c thn els) = If c (f thn) (f els)++instance HFunctor Loop+  where+    hfmap f (Loop n body) = Loop n (f body)++instance HFunctor Ref+  where+    hfmap f (NewRef a)   = NewRef a+    hfmap f (GetRef r)   = GetRef r+    hfmap f (SetRef r a) = SetRef r a++instance Interp If IO+  where+    interp (If c thn els) = if eval c then thn else els++instance Interp Loop IO+  where+    interp (Loop n body) = replicateM_ (eval n) body++instance Interp Ref IO+  where+    interp (NewRef a)   = newIORef (eval a)+    interp (GetRef r)   = fmap Lit $ readIORef r+    interp (SetRef r a) = writeIORef r (eval a)++++--------------------------------------------------------------------------------+-- Example+--------------------------------------------------------------------------------++type MyProgram a = Program (If :+: Loop :+: Ref) a++iff :: Exp Bool -> MyProgram a -> MyProgram a -> MyProgram a+iff c thn els = singleInj $ If c thn els++loop :: Exp Int -> MyProgram () -> MyProgram ()+loop n = singleInj . Loop n++newRef :: Exp a -> MyProgram (IORef a)+newRef = singleInj . NewRef++getRef :: IORef a -> MyProgram (Exp a)+getRef = singleInj . GetRef++setRef :: IORef a -> Exp a -> MyProgram ()+setRef r = singleInj . SetRef r++prog :: MyProgram (Exp Int)+prog = do+    r <- newRef 0+    loop 10 $ do+        a <- getRef r+        iff (Eq a 3)+            (setRef r 100)+            (setRef r (a+1))+    singleInj $ GetRef r++main = fmap eval $ interpret prog+
+ operational-alacarte.cabal view
@@ -0,0 +1,71 @@+name:                operational-alacarte+version:             0.1+synopsis:            A version of Operational suitable for extensible EDSLs+description:         A version of Operational \[1\] suitable for EDSLs+                     extensible via data types à la carte.+                     .+                     More information is found in the documentation of+                     "Control.Monad.Operational.Higher".+                     .+                     \[1\] <http://hackage.haskell.org/package/operational>+license:             BSD3+license-file:        LICENSE+author:              Emil Axelsson+maintainer:          emax@chalmers.se+copyright:           Copyright 2015 Emil Axelsson+homepage:            https://github.com/emilaxelsson/operational-alacarte+bug-reports:         https://github.com/emilaxelsson/operational-alacarte/issues+category:            Language+build-type:          Simple+cabal-version:       >=1.10++source-repository head+  type:     git+  location: git@github.com:emilaxelsson/operational-alacarte.git++library+  exposed-modules:+    Data.ALaCarte+    Control.Monad.Operational.Higher++  default-language: Haskell2010++  default-extensions:+    DeriveDataTypeable+    DeriveFunctor+    FlexibleInstances+    GADTs+    KindSignatures+    MultiParamTypeClasses+    Rank2Types+    ScopedTypeVariables+    TypeFamilies+    TypeOperators++    -- DeriveDataTypeable only needed for GHC < 7.10++  build-depends:+    base >=4 && <5,+    mtl++  hs-source-dirs: src++test-suite Examples+  type: exitcode-stdio-1.0++  hs-source-dirs: examples++  main-is: Simple.hs++  default-language: Haskell2010++  default-extensions:+    GADTs+    KindSignatures+    MultiParamTypeClasses+    TypeOperators++  build-depends:+    base,+    operational-alacarte+
+ src/Control/Monad/Operational/Higher.hs view
@@ -0,0 +1,267 @@+{-# LANGUAGE CPP #-}++-- | = Introduction+--+-- This module gives an alternative to the Operational package \[1\], in which+-- instructions are higher-order functors, parameterized on the program monad+-- that they are part of. This makes it possible to define instruction sets+-- compositionally using ':+:'. In the normal Operational, this can be done for+-- simple instructions, but here it can be done even for \"control+-- instructions\" -- instructions that take program as arguments.+--+-- For general information about the ideas behind this module, see the+-- Operational package: <http://hackage.haskell.org/package/operational>+--+-- = Example+--+-- (Full code found in+-- <https://github.com/emilaxelsson/operational-alacarte/blob/master/examples/Simple.hs>.)+--+-- An \"if\" instruction can be defined as follows:+--+-- @+-- data If p a where+--   If :: Exp `Bool` -> p a -> p a -> If p a+-- @+--+-- Note the use of the type parameter @p@ to refer to sub-programs. (@Exp@ is+-- some type representing pure expressions.)+--+-- We can now make program types that combine several instructions; e.g.:+--+-- @type MyProgram a = `Program` (If `:+:` Loop `:+:` ...) a@+--+-- Here the sub-programs of @If@ (and @Loop@, etc.) will have the type+-- @MyProgram@. With the original Operational package, we would have to+-- hard-code a specific type for the sub-programs of @If@ (or make @MyProgram@ a+-- recursive newtype, as noted by the author of Operational).+--+-- Interpretation of 'Program' can be done using+--+-- @`interpret` :: (`Interp` i m, `HFunctor` i, `Monad` m) => `Program` i a -> m a@+--+-- In order to use this function, @If@ needs to be an instance of 'Interp' and+-- 'HFunctor'. The 'HFunctor' instance is straightforward:+--+-- @+-- instance `HFunctor` If where+--   `hfmap` f (If c thn els) = If c (f thn) (f els)+-- @+--+-- The 'Interp' type class is parameterized both on the instruction and the+-- destination monad. For example, interpretation of @If@ in the IO monad might+-- look as follows:+--+-- @+-- instance `Interp` If `IO` where+--   `interp` (If c thn els) = if eval c then thn else els+-- @+--+-- (Here @eval@ is the evaluator for the expression languauge @Exp@.)+--+-- The 'Interp' class distributes over ':+:' which means that it is possible to+-- interpret any expression type @(I1 `:+:` I2 `:+:` I3 `:+:` ...)@ to 'IO', as+-- long as the individual instructions (@I1@, @I2@, etc.) have 'Interp'+-- instances for 'IO'.++module Control.Monad.Operational.Higher+    ( module Control.Monad+    , module Data.ALaCarte+      -- * Program monad+    , ProgramT+    , Program+    , singleton+    , singleInj+      -- * Interpretation+    , liftProgram+    , interpretWithMonadT+    , interpretWithMonad+    , Interp (..)+    , interpretT+    , interpret+    , ProgramViewT (..)+    , ProgramView (..)+    , viewT+    , view+    , unview+      -- * Instructions parameterized on expression language+    , IExp+    , injE+    , prjE+    , singleE+    ) where++++#if __GLASGOW_HASKELL__ < 710+import Control.Applicative+#endif+import Control.Monad+import Control.Monad.Identity+import Control.Monad.Trans+import Data.Typeable++import Data.ALaCarte++++----------------------------------------------------------------------------------------------------+-- * Program monad+----------------------------------------------------------------------------------------------------++-- | Representation of programs parameterized by the primitive instructions+data ProgramT instr m a+  where+    Lift  :: m a -> ProgramT instr m a+    Bind  :: ProgramT instr m a -> (a -> ProgramT instr m b) -> ProgramT instr m b+    Instr :: instr (ProgramT instr m) a -> ProgramT instr m a+#if  __GLASGOW_HASKELL__>=708+  deriving Typeable+#endif++-- | Representation of programs parameterized by its primitive instructions+type Program instr = ProgramT instr Identity++instance Monad m => Functor (ProgramT instr m)+  where+    fmap = liftM++instance Monad m => Applicative (ProgramT instr m)+  where+    pure  = return+    (<*>) = ap++instance Monad m => Monad (ProgramT instr m)+  where+    return = Lift . return+    (>>=)  = Bind++instance MonadTrans (ProgramT instr)+  where+    lift = Lift++-- | Make a program from a single primitive instruction+singleton :: instr (ProgramT instr m) a -> ProgramT instr m a+singleton = Instr++-- | Make a program from a single primitive instruction+singleInj :: (i :<: instr) => i (ProgramT instr m) a -> ProgramT instr m a+singleInj = Instr . inj++++----------------------------------------------------------------------------------------------------+-- * Interpretation+----------------------------------------------------------------------------------------------------++-- | Lift a simple program to a program over a monad @m@+liftProgram :: forall instr m a . (HFunctor instr, Monad m) => Program instr a -> ProgramT instr m a+liftProgram = go+  where+    go :: Program instr b -> ProgramT instr m b+    go (Lift a)   = Lift $ return $ runIdentity a+    go (Bind p k) = Bind (go p) (go . k)+    go (Instr i)  = Instr $ hfmap go i++-- | Interpret a program in a monad+interpretWithMonadT :: forall instr m n a . (HFunctor instr, Monad m)+    => (forall b . instr m b -> m b)+    -> (forall b . n b -> m b)+    -> ProgramT instr n a -> m a+interpretWithMonadT runi runn = go+  where+    go :: ProgramT instr n b -> m b+    go (Lift a)   = runn a+    go (Bind p k) = go p >>= (go . k)+    go (Instr i)  = runi $ hfmap go i++-- | Interpret a program in a monad+interpretWithMonad :: (HFunctor instr, Monad m) =>+    (forall b . instr m b -> m b) -> Program instr a -> m a+interpretWithMonad interp = interpretWithMonadT interp (return . runIdentity)++-- | @`Interp` i m@ represents the fact that @i@ can be interpreted in the monad @m@+class Interp i m+  where+    -- | Interpret an instruction in a monad+    interp :: i m a -> m a++instance (Interp i1 m, Interp i2 m) => Interp (i1 :+: i2) m+  where+    interp (Inl i) = interp i+    interp (Inr i) = interp i++-- | Interpret a program in a monad. The interpretation of primitive instructions is provided by the+-- 'Interp' class.+interpretT :: (Interp i m, HFunctor i, Monad m) => (forall b . n b -> m b) -> ProgramT i n a -> m a+interpretT = interpretWithMonadT interp++-- | Interpret a program in a monad. The interpretation of primitive instructions is provided by the+-- 'Interp' class.+interpret :: (Interp i m, HFunctor i, Monad m) => Program i a -> m a+interpret = interpretWithMonad interp++-- | View type for inspecting the first instruction+data ProgramViewT instr m a+  where+    Return :: a -> ProgramViewT instr m a+    (:>>=) :: instr (ProgramT instr m) b -> (b -> ProgramT instr m a) -> ProgramViewT instr m a++-- | View type for inspecting the first instruction+type ProgramView instr = ProgramViewT instr Identity++-- | View function for inspecting the first instruction+viewT :: Monad m => ProgramT instr m a -> m (ProgramViewT instr m a)+viewT (Lift m)                = m >>= return . Return+viewT (Lift m       `Bind` g) = m >>= viewT . g+viewT ((m `Bind` g) `Bind` h) = viewT (m `Bind` (\x -> g x `Bind` h))+viewT (Instr i      `Bind` g) = return (i :>>= g)+viewT (Instr i)               = return (i :>>= return)++-- | View function for inspecting the first instruction+view :: HFunctor instr => Program instr a -> ProgramView instr a+view = runIdentity . viewT++-- | Turn a 'ProgramViewT' back to a 'Program'+unview :: Monad m => ProgramViewT instr m a -> ProgramT instr m a+unview (Return a) = return a+unview (i :>>= k) = singleton i >>= k++++--------------------------------------------------------------------------------+-- * Instructions parameterized on expression language+--------------------------------------------------------------------------------++-- | Extract the expression type from an instruction set+--+-- 'IExp' is needed to avoid types like+-- @(`SomeInstr` exp `:<:` i) => `Program` i ()@. Here it is not possible to+-- constrain @exp@ by constraining @i@, so the instance search will always fail.+-- Functions like 'injE' solve this by using 'IExp' to determine @exp@ from @i@.+-- For this to work, one must use an instruction set @i@ that has an instance of+-- 'IExp'.+--+-- It is common for all instructions in a sum (using ':+:') to use the same+-- expression type. For this common case, it is enough to get the expression+-- type from the first summand. This can be achieved by giving two  'IExp'+-- instances for each instruction:+--+-- @+-- type instance `IExp` (SomeInstr exp)       = exp+-- type instance `IExp` (SomeInstr exp `:+:` i) = exp+-- @+type family IExp (i :: (* -> *) -> * -> *) :: * -> *++-- | Inject an instruction that is parameterized by an expression type+injE :: (i (IExp instr) :<: instr) => i (IExp instr) m a -> instr m a+injE = inj++-- | Project an instruction that is parameterized by an expression type+prjE :: (i (IExp instr) :<: instr) => instr m a -> Maybe (i (IExp instr) m a)+prjE = prj++-- | Create a program from an instruction that is parameterized by an expression type+singleE :: (i (IExp instr) :<: instr) => i (IExp instr) (ProgramT instr m) a -> ProgramT instr m a+singleE = singleton . inj+
+ src/Data/ALaCarte.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE PolyKinds #-}++#ifndef MIN_VERSION_GLASGOW_HASKELL+#define MIN_VERSION_GLASGOW_HASKELL(a,b,c,d) 0+#endif+  -- MIN_VERSION_GLASGOW_HASKELL was introduced in GHC 7.10++#if MIN_VERSION_GLASGOW_HASKELL(7,10,0,0)+#else+{-# LANGUAGE OverlappingInstances #-}+#endif++-- | Higher-order (and poly-kinded) implementation of Data Types à la Carte [1]+--+-- \[1\] W. Swierstra. Data Types à la Carte.+--       /Journal of Functional Programming/, 18(4):423-436, 2008,+--       <http://dx.doi.org/10.1017/S0956796808006758>.++module Data.ALaCarte where++++-- | Coproducts+data (f :+: g) a b+    = Inl (f a b)+    | Inr (g a b)+#if  __GLASGOW_HASKELL__>=708+  deriving (Functor)+#endif++infixr :+:++-- | A constraint @f `:<:` g@ expresses that the signature @f@ is subsumed by+-- @g@, i.e. @f@ can be used to construct elements in @g@.+class f :<: g+  where+    inj :: f a b -> g a b+    prj :: g a b -> Maybe (f a b)++instance {-# OVERLAPPING #-} (f :<: f)+  where+    inj = id+    prj = Just++instance {-# OVERLAPPING #-} (f :<: (f :+: g))+  where+    inj = Inl+    prj (Inl f) = Just f+    prj _       = Nothing++instance {-# OVERLAPPING #-} (f :<: h) => (f :<: (g :+: h))+  where+    inj = Inr . inj+    prj (Inr h) = prj h+    prj _       = Nothing++-- | Higher-order functors+class HFunctor h+  where+    -- | Higher-order 'fmap'+    hfmap :: (forall b . m b -> n b) -> h m a -> h n a++instance (HFunctor h1, HFunctor h2) => HFunctor (h1 :+: h2)+  where+    hfmap f (Inl i) = Inl (hfmap f i)+    hfmap f (Inr i) = Inr (hfmap f i)+