operational-alacarte 0.1.1 → 0.2

raw patch · 5 files changed

+535/−234 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• examples/Simple.hs +0/−114
• operational-alacarte.cabal +18/−12
• src/Control/Monad/Operational/Higher.hs +365/−99
• src/Data/ALaCarte.hs +145/−9
• tests/Tests.hs +7/−0

@@ -1,114 +0,0 @@-{-# 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-

@@ -1,9 +1,20 @@ name:                operational-alacarte-version:             0.1.1+version:             0.2 synopsis:            A version of Operational suitable for extensible EDSLs description:         A version of Operational \[1\] suitable for EDSLs                      extensible via data types à la carte.                      .+                     This library provides two important extensions to+                     Operational:+                     .+                     1. The ability for instructions to refer to sub-programs in+                        a generic way. (This is a key to obtaining an extensible+                        library.)+                     .+                     2. Generic interpretation of programs, including+                        sub-programs and other sub-structures (e.g.+                        expressions).+                     .                      More information is found in the documentation of                      "Control.Monad.Operational.Higher".                      .@@ -12,7 +23,8 @@ license-file:        LICENSE author:              Emil Axelsson maintainer:          emax@chalmers.se-copyright:           Copyright 2015 Emil Axelsson, Heinrich Apfelmus+copyright:           Copyright (c) 2015 Emil Axelsson, Heinrich Apfelmus+                     Copyright (c) 2016 Emil Axelsson homepage:            https://github.com/emilaxelsson/operational-alacarte bug-reports:         https://github.com/emilaxelsson/operational-alacarte/issues category:            Language@@ -31,15 +43,15 @@   default-language: Haskell2010    default-extensions:+    DataKinds     DeriveDataTypeable     DeriveFunctor     FlexibleInstances     GADTs-    KindSignatures     MultiParamTypeClasses+    PolyKinds     Rank2Types     ScopedTypeVariables-    TypeFamilies     TypeOperators      -- DeriveDataTypeable only needed for GHC < 7.10@@ -53,17 +65,11 @@ test-suite Examples   type: exitcode-stdio-1.0 -  hs-source-dirs: examples+  hs-source-dirs: examples tests -  main-is: Simple.hs+  main-is: Tests.hs    default-language: Haskell2010--  default-extensions:-    GADTs-    KindSignatures-    MultiParamTypeClasses-    TypeOperators    build-depends:     base,

@@ -3,15 +3,17 @@ -- | = Introduction -- -- This module gives an alternative to the Operational package \[1\], in which--- instructions are higher-order functors, parameterized on the program monad+-- instructions can be 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.+-- compositionally using ':+:'. In the normal Operational, this could be done+-- for simple instructions, but here it can be done even for \"control+-- instructions\" -- instructions that take programs as arguments. -- -- For general information about the ideas behind this module, see the--- Operational package: <http://hackage.haskell.org/package/operational>+-- Operational package \[1\]. --+-- \[1\] <http://hackage.haskell.org/package/operational>+-- -- = Example -- -- (Full code found in@@ -20,25 +22,28 @@ -- An \"if\" instruction can be defined as follows: -- -- @--- data If p a where---   If :: Exp `Bool` -> p a -> p a -> If p a+-- data If fs a where+--   If :: Exp `Bool` -> prog a -> prog a -> If (`Param1` prog) a -- @ ----- Note the use of the type parameter @p@ to refer to sub-programs. (@Exp@ is+-- Note the use of the type parameter @prog@ to refer to sub-programs. (@Exp@ is -- some type representing pure expressions.) --+-- The type @(`Param1` prog)@ can be seen as a type-level list with one element+-- @prog@. (See "Data.ALaCarte" for more details on parameter lists.)+-- -- We can now make program types that combine several instructions; e.g.: ----- @type MyProgram a = `Program` (If `:+:` Loop `:+:` ...) a@+-- @type MyProgram = `Program` (If `:+:` Loop `:+:` ...) `Param0`@ ----- 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).+-- 'Program' is a recursive type that sets the type of the sub-programs of @If@+-- (and @Loop@, etc.) to @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+-- Interpretation of 'Program' in a monad @m@ can be done using ----- @`interpret` :: (`Interp` i m, `HFunctor` i, `Monad` m) => `Program` i a -> m a@+-- @`interpret` :: (`Interp` i m fs, `HFunctor` i, `Monad` m) => `Program` i fs a -> m a@ -- -- In order to use this function, @If@ needs to be an instance of 'Interp' and -- 'HFunctor'. The 'HFunctor' instance is straightforward:@@ -48,12 +53,12 @@ --   `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:+-- The 'Interp' type class is parameterized both on the instruction type and the+-- destination monad. For example, interpretation of @If@ in the 'IO' monad+-- might look as follows: -- -- @--- instance `Interp` If `IO` where+-- instance `Interp` If `IO` fs where --   `interp` (If c thn els) = if eval c then thn else els -- @ --@@ -63,6 +68,137 @@ -- interpret any expression type @(I1 `:+:` I2 `:+:` I3 `:+:` ...)@ to 'IO', as -- long as the individual instructions (@I1@, @I2@, etc.) have 'Interp' -- instances for 'IO'.+--+-- = Bi-functorial instructions+--+-- The type @(`Param1` prog)@ in the result of @If@ above says that the+-- instruction has one sub-structure whose type is @prog@. The advanced example+-- <https://github.com/emilaxelsson/operational-alacarte/blob/master/examples/Advanced.hs>+-- shows a version of @If@ that has two parameters:+--+-- @+--   If :: exp `Bool` -> prog a -> prog a -> If (`Param2` prog exp) a+-- @+--+-- @prog@ represents sub-programs and @exp@ represents expressions (@Exp Bool@+-- has been replaced with @exp Bool@).+--+-- This new @If@ instruction is a higher-order /bi-functor/ (see 'HBifunctor').+--+-- The advantage of parameterizing instructions on expressions is that it lets+-- us define generic functions, such as `interpretBi`, which decouple the+-- interpretation of instructions from the interpretation of expressions.+--+-- = Generalized interface+--+-- We have seen two examples of @If@ with a parameter list of one and two+-- arguments respectively (@(`Param1` prog)@ and @(`Param2` prog exp)@). There+-- is nothing stopping us from having instructions with more parameters. For+-- example, we could make a version of @If@ that takes an extra type class+-- constraint @pred@ as parameter:+--+-- @+--   If :: pred a => exp `Bool` -> prog a -> prog a -> If (`Param3` prog exp pred) a+-- @+--+-- (See the documentation to "Data.ALaCarte" regarding why it is a good idea to+-- make @pred@ part of the parameter list rather than just making it a separate+-- parameter.)+--+-- In fact, it is possible to have arbitrarily many parameters to instructions+-- (but the type synonyms for parameter lists stop at 'Param4').+--+-- The functions and types in this module (and "Data.ALaCarte") are designed to+-- be generic in the sense that things that work for parameter lists of /N/+-- elements also work for parameter lists of more elements. For example, the+-- function 'interpret' mentioned above requires the instruction @i@ to be a+-- higher-order functor, but it also works for high-order bi-functors, and for+-- the last version of @If@ that has an additional parameter @pred@.+--+-- = Typical use+--+-- Here we give specialized type signatures for a selection of functions for+-- different uses of the general interface.+--+-- .+--+-- __Functorial instructions with no extra parameters__+--+-- This scenario is used in <https://github.com/emilaxelsson/operational-alacarte/blob/master/examples/Simple.hs>.+--+-- @+-- `singleton` :: instr (`Param1` (`ProgramT` instr `Param0` m)) a -> `ProgramT` instr `Param0` m a+--+-- `interpretWithMonad`+--     :: (`HFunctor` instr, `Monad` m)+--     => (forall b . instr (`Param1` m) b -> m b)+--     -> `Program` instr `Param0` a -> m a+--+-- `interpret`+--     :: (`Interp` i m `Param0`, `HFunctor` i, `Monad` m)+--     => `Program` i `Param0` a -> m a+-- @+--+-- .+--+-- __Functorial instructions with extra parameter__+--+-- Like the previous scenario but with an extra parameter @p@ (poly-kinded) that instructions can use for anything.+--+-- @+-- `singleton` :: instr (`Param2` (`ProgramT` instr (`Param1` p) m) p) a -> `ProgramT` instr (`Param1` p) m a+--+-- `interpretWithMonad`+--     :: (`HFunctor` instr, `Monad` m)+--     => (forall b . instr (`Param2` m p) b -> m b)+--     -> `Program` instr (`Param1` p) a -> m a+--+-- `interpret`+--     :: (`Interp` i m (`Param1` p), `HFunctor` i, `Monad` m)+--     => `Program` i (`Param1` p) a -> m a+-- @+--+-- .+--+-- __Bi-functorial instructions with no extra parameters__+--+-- This scenario is used in <https://github.com/emilaxelsson/operational-alacarte/blob/master/examples/Advanced.hs>.+--+-- The parameter @exp@ is an extra interpreted structure that e.g. can represent expressions.+--+-- @+-- `singleton` :: instr (`Param2` (`ProgramT` instr (`Param1` exp) m) exp) a -> `ProgramT` instr (`Param1` exp) m a+--+-- `interpretWithMonadBi`+--     :: (`HBifunctor` instr, `Functor` m, `Monad` m)+--     => (forall b . exp b -> m b)+--     -> (forall b . instr (`Param2` m m) b -> m b)+--     -> `Program` instr (`Param1` exp) a -> m a+--+-- `interpret`+--     :: (`InterpBi` i m `Param0`, `HBifunctor` i, `Functor` m, `Monad` m)+--     => (forall b . exp b -> m b) -> `Program` i (`Param1` exp) a -> m a+-- @+--+-- .+--+-- __Bi-functorial instructions with extra parameter__+--+-- Like the previous scenario but with an extra parameter @p@ (poly-kinded) that instructions can use for anything.+--+-- @+-- `singleton` :: instr (`Param3` (`ProgramT` instr (`Param2` exp p) m) exp p) a -> `ProgramT` instr (`Param2` exp p) m a+--+-- `interpretWithMonadBi`+--     :: (`HBifunctor` instr, `Functor` m, `Monad` m)+--     => (forall b . exp b -> m b)+--     -> (forall b . instr (`Param3` m m p) b -> m b)+--     -> `Program` instr (`Param2` exp p) a -> m a+--+-- `interpret`+--     :: (`InterpBi` i m (`Param1` p), `HBifunctor` i, `Functor` m, `Monad` m)+--     => (forall b . exp b -> m b) -> `Program` i (`Param2` exp p) a -> m a+-- @  module Control.Monad.Operational.Higher     ( module Control.Monad@@ -81,14 +217,20 @@     , interpret     , ProgramViewT (..)     , ProgramView (..)+    , ProgViewT+    , ProgView     , viewT     , view     , unview-      -- * Instructions parameterized on expression language-    , IExp-    , injE-    , prjE-    , singleE+      -- * Bi-functorial instructions+    , interpretWithMonadBiT+    , interpretWithMonadBi+    , InterpBi (..)+    , interpretBiT+    , interpretBi+    , Reexpressible (..)+    , reexpress+    , reexpressEnv     ) where  @@ -98,120 +240,135 @@ #endif import Control.Monad import Control.Monad.Identity-import Control.Monad.Trans+import Control.Monad.Reader import Data.Typeable  import Data.ALaCarte   -----------------------------------------------------------------------------------------------------+-------------------------------------------------------------------------------- -- * Program monad-----------------------------------------------------------------------------------------------------+--------------------------------------------------------------------------------  -- | Representation of programs parameterized by the primitive instructions-data ProgramT instr m a+-- (transformer version)+data ProgramT instr fs 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+    Lift  :: m a -> ProgramT instr fs m a+    Bind  :: ProgramT instr fs m a ->+               (a -> ProgramT instr fs m b) -> ProgramT instr fs m b+    Instr :: instr '(ProgramT instr fs m, fs) a -> ProgramT instr fs m a #if  __GLASGOW_HASKELL__>=708   deriving Typeable #endif --- | Representation of programs parameterized by its primitive instructions-type Program instr = ProgramT instr Identity+-- | Representation of programs parameterized by the primitive instructions+type Program instr fs = ProgramT instr fs Identity -instance Monad m => Functor (ProgramT instr m)+instance Monad m => Functor (ProgramT instr fs m)   where     fmap = liftM -instance Monad m => Applicative (ProgramT instr m)+instance Monad m => Applicative (ProgramT instr fs m)   where     pure  = return     (<*>) = ap -instance Monad m => Monad (ProgramT instr m)+instance Monad m => Monad (ProgramT instr fs m)   where     return = Lift . return     (>>=)  = Bind -instance MonadTrans (ProgramT instr)+instance MonadTrans (ProgramT instr fs)   where     lift = Lift --- | Make a program from a single primitive instruction-singleton :: instr (ProgramT instr m) a -> ProgramT instr m a+-- | Make a program from a single instruction+singleton :: instr '(ProgramT instr fs m, fs) a -> ProgramT instr fs m a singleton = Instr --- | Make a program from a single primitive instruction-singleInj :: (i :<: instr) => i (ProgramT instr m) a -> ProgramT instr m a+-- | Make a program from a single instruction+singleInj :: (i :<: instr) =>+    i '(ProgramT instr fs m, fs) a -> ProgramT instr fs 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+-- | Lift a program to a program transformer+liftProgram :: forall instr fs m a . (HFunctor instr, Monad m)+    => Program instr fs a  -- ^ Program to lift+    -> ProgramT instr fs m a liftProgram = go   where-    go :: Program instr b -> ProgramT instr m b+    go :: Program instr fs b -> ProgramT instr fs 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+interpretWithMonadT :: forall instr fs m n a . (HFunctor instr, Monad m)+    => (forall b . instr '(m,fs) b -> m b)  -- ^ Interpretation of instructions+    -> (forall b . n b -> m b)              -- ^ Interpretation of the underlying monad+    -> ProgramT instr fs n a -> m a+interpretWithMonadT inti intn = go   where-    go :: ProgramT instr n b -> m b-    go (Lift a)   = runn a+    go :: ProgramT instr fs n b -> m b+    go (Lift a)   = intn a     go (Bind p k) = go p >>= (go . k)-    go (Instr i)  = runi $ hfmap go i+    go (Instr i)  = inti $ 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 :: (HFunctor instr, Monad m)+    => (forall b . instr '(m,fs) b -> m b)  -- ^ Interpretation of instructions+    -> Program instr fs 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+-- | @`Interp` instr m fs@ represents the fact that @instr@ can be interpreted+-- in the monad @m@+class Interp instr m fs   where     -- | Interpret an instruction in a monad-    interp :: i m a -> m a+    interp :: instr '(m,fs) a -> m a -instance (Interp i1 m, Interp i2 m) => Interp (i1 :+: i2) m+instance (Interp i1 m fs, Interp i2 m fs) => Interp (i1 :+: i2) m fs   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+-- | Interpret a program in a monad. The interpretation of instructions is+-- provided by the 'Interp' class.+interpretT :: (Interp i m fs, HFunctor i, Monad m)+    => (forall b . n b -> m b)  -- ^ Interpretation of the underlying monad+    -> ProgramT i fs 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 a program in a monad. The interpretation of instructions is+-- provided by the 'Interp' class.+interpret :: (Interp i m fs, HFunctor i, Monad m) => Program i fs a -> m a interpret = interpretWithMonad interp  -- | View type for inspecting the first instruction-data ProgramViewT instr m a+data ProgramViewT instr fs m a   where-    Return :: a -> ProgramViewT instr m a-    (:>>=) :: instr (ProgramT instr m) b -> (b -> ProgramT instr m a) -> ProgramViewT instr m a+    Return :: a -> ProgramViewT instr fs m a+    (:>>=)+        :: instr '(ProgramT instr fs m, fs) b+        -> (b -> ProgramT instr fs m a)+        -> ProgramViewT instr fs m a  -- | View type for inspecting the first instruction-type ProgramView instr = ProgramViewT instr Identity+type ProgramView instr fs = ProgramViewT instr fs Identity +type ProgViewT instr m = ProgramViewT instr '() m+type ProgView instr    = ProgramView instr '()+ -- | View function for inspecting the first instruction-viewT :: Monad m => ProgramT instr m a -> m (ProgramViewT instr m a)+viewT :: Monad m => ProgramT instr fs m a -> m (ProgramViewT instr fs 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))@@ -219,49 +376,158 @@ viewT (Instr i)               = return (i :>>= return)  -- | View function for inspecting the first instruction-view :: HFunctor instr => Program instr a -> ProgramView instr a+view :: HFunctor instr => Program instr fs a -> ProgramView instr fs a view = runIdentity . viewT  -- | Turn a 'ProgramViewT' back to a 'Program'-unview :: Monad m => ProgramViewT instr m a -> ProgramT instr m a+unview :: Monad m => ProgramViewT instr fs m a -> ProgramT instr fs m a unview (Return a) = return a unview (i :>>= k) = singleton i >>= k    ----------------------------------------------------------------------------------- * Instructions parameterized on expression language+-- * Bi-functorial instructions -------------------------------------------------------------------------------- --- | Extract the expression type from an instruction set+-- | Bi-functorial version of 'interpretWithMonadT' ----- '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'.+-- Bi-functorial instructions are of the form @instr '(prog, '(exp, ...)) a@,+-- where @prog@ is a representation of sub-programs, and @exp@ is a+-- representation of some other sub-structure, e.g. expressions.+-- 'interpretWithMonadBiT' allows interpreting both these kinds of+-- sub-structures in a generic way.+interpretWithMonadBiT :: (HBifunctor instr, Functor m, Monad m, Monad n)+    => (forall b . exp b -> m b)                 -- ^ Interpretation of the @exp@ sub-structure+    -> (forall b . instr '(m,'(m,fs)) b -> m b)  -- ^ Interpretation of instructions+    -> (forall b . n b -> m b)                   -- ^ Interpretation of the underlying monad+    -> ProgramT instr '(exp,fs) n a -> m a+interpretWithMonadBiT inte inti intn = interpretWithMonadT+    (\i -> inti $ hbimap id inte i)+    intn++-- | Bi-functorial version of 'interpretWithMonad' ----- 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:+-- See explanation of 'interpretWithMonadBiT'.+interpretWithMonadBi :: (HBifunctor instr, Functor m, Monad m)+    => (forall b . exp b -> m b)                 -- ^ Interpretation of the @exp@ sub-structure+    -> (forall b . instr '(m,'(m,fs)) b -> m b)  -- ^ Interpretation of instructions+    -> Program instr '(exp,fs) a -> m a+interpretWithMonadBi inte inti = interpretWithMonadBiT inte inti+    (return . runIdentity)++-- | @`InterpBi` instr m fs@ represents the fact that the bi-functorial+-- instruction @instr@ can be interpreted in the monad @m@+class InterpBi instr m fs+  where+    -- | Interpret a bi-functorial instruction in a monad+    interpBi :: instr '(m,'(m,fs)) a -> m a++instance (InterpBi i1 m fs, InterpBi i2 m fs) => InterpBi (i1 :+: i2) m fs+  where+    interpBi (Inl i) = interpBi i+    interpBi (Inr i) = interpBi i++-- | Interpret a program in a monad. The interpretation of instructions is+-- provided by the 'InterpBi' class.+interpretBiT :: (InterpBi i m fs, HBifunctor i, Functor m, Monad m, Monad n)+    => (forall b . exp b -> m b)  -- ^ Interpretation of the @exp@ sub-structure+    -> (forall b . n b -> m b)    -- ^ Interpretation of the underlying monad+    -> ProgramT i '(exp,fs) n a -> m a+interpretBiT inte = interpretWithMonadBiT inte interpBi+  -- The reason for only getting the interpretation of instructions from a class+  -- (and not the interpretation of `exp`), is that `interpBi` is constructed+  -- automatically for instructions built using `:+:`. It would be quite+  -- cumbersome to construct this function by hand.++-- | Interpret a program in a monad. The interpretation of instructions is+-- provided by the 'InterpBi' class.+interpretBi :: (InterpBi i m fs, HBifunctor i, Functor m, Monad m)+    => (forall b . exp b -> m b)  -- ^ Interpretation of the @exp@ sub-structure+    -> Program i '(exp,fs) a -> m a+interpretBi inte = interpretWithMonadBi inte interpBi++-- | Reexpressible types ----- @--- type instance `IExp` (SomeInstr exp)       = exp--- type instance `IExp` (SomeInstr exp `:+:` i) = exp--- @-type family IExp (i :: (* -> *) -> * -> *) :: * -> *+-- @i@ is a bi-functorial instruction where, in the type @i '(p,'(e1,...)) a@,+-- sub-structure @e1@ can be converted to a different sub-structure @e2@.+--+-- @e1@ and @e2@ typically represent expressions; hence the name+-- \"reexpressible\".+class HBifunctor i => Reexpressible i instr+  where+    -- | Rewrite an instruction changing its \"expression\" sub-structure+    reexpressInstr :: Monad m+        => (forall b . exp1 b -> ProgramT instr '(exp2,fs) m (exp2 b))+             -- ^ Conversion of the \"expression\" sub-structure+        -> i '(ProgramT instr '(exp2,fs) m, '(exp1, fs)) a+        -> ProgramT instr '(exp2,fs) m a+    reexpressInstr reexp+        = flip runReaderT ()+        . reexpressInstrEnv (lift . reexp)+        . hbimap lift id --- | 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+    -- | Rewrite an instruction changing its \"expression\" sub-structure+    --+    -- As an example of how to define this function, take the following+    -- instruction that just puts a tag on a sub-program:+    --+    -- > data Tag fs a+    -- >   where+    -- >     Tag :: String -> prog () -> Tag (Param2 prog exp) ()+    --+    -- To define `reexpressInstrEnv` we have to use a combination of `ReaderT`+    -- and `runReaderT`:+    --+    -- > instance (Tag :<: instr) => Reexpressible Tag instr+    -- >   where+    -- >     reexpressInstrEnv reexp (Tag tag prog) = ReaderT $ \env ->+    -- >         singleInj $ Tag tag (flip runReaderT env prog)+    reexpressInstrEnv :: Monad m+        => ( forall b .+               exp1 b -> ReaderT env (ProgramT instr '(exp2,fs) m) (exp2 b)+           )+             -- ^ Conversion of the \"expression\" sub-structure+        -> i '(ReaderT env (ProgramT instr '(exp2,fs) m), '(exp1, fs)) a+        -> ReaderT env (ProgramT instr '(exp2,fs) m) a+      -- The reason for only allowing `ReaderT` is that for instructions that+      -- have sub-programs, this seems to be the only possible transformer for+      -- which `reexpressInstrEnv` can be defined (among common monads). E.g.+      -- the above trick with `runReaderT` doesn't work for `StateT`. --- | 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+instance (Reexpressible i1 instr, Reexpressible i2 instr) =>+    Reexpressible (i1 :+: i2) instr+  where+    reexpressInstr    reexp (Inl i) = reexpressInstr    reexp i+    reexpressInstr    reexp (Inr i) = reexpressInstr    reexp i+    reexpressInstrEnv reexp (Inl i) = reexpressInstrEnv reexp i+    reexpressInstrEnv reexp (Inr i) = reexpressInstrEnv reexp i --- | 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+-- | Rewrite a program changing its expression type (assuming that the second+-- sub-structure of the instruction type represents expressions)+--+-- Conversion of expressions is done in the target monad, so pure expressions+-- are allowed to expand to monadic code. This can be used e.g. to \"compile\"+-- complex expressions into simple expressions with supporting monadic code.+reexpress :: (Reexpressible instr1 instr2, Monad m)+    => (forall b . exp1 b -> ProgramT instr2 '(exp2,fs) m (exp2 b))+         -- ^ Conversion of expressions+    -> ProgramT instr1 '(exp1,fs) m a -> ProgramT instr2 '(exp2,fs) m a+reexpress reexp p = interpretWithMonadT (reexpressInstr reexp) lift p++-- | Rewrite a program changing its expression type (assuming that the second+-- sub-structure of the instruction type represents expressions)+--+-- Conversion of expressions is done in the target monad, so pure expressions+-- are allowed to expand to monadic code. This can be used e.g. to \"compile\"+-- complex expressions into simple expressions with supporting monadic code.+reexpressEnv :: (Reexpressible instr1 instr2, Monad m)+    => ( forall b .+            exp1 b -> ReaderT env (ProgramT instr2 '(exp2,fs) m) (exp2 b)+       )+         -- ^ Conversion of expressions+    -> ProgramT instr1 '(exp1,fs) m a+    -> ReaderT env (ProgramT instr2 '(exp2,fs) m) a+reexpressEnv reexp p =+    interpretWithMonadT (reexpressInstrEnv reexp) (lift . lift) p 

@@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE PolyKinds #-}  #ifndef MIN_VERSION_GLASGOW_HASKELL #define MIN_VERSION_GLASGOW_HASKELL(a,b,c,d) 0@@ -11,20 +10,121 @@ {-# LANGUAGE OverlappingInstances #-} #endif --- | Higher-order (and poly-kinded) implementation of Data Types à la Carte [1]+-- | This module provides a generalized implementation of data types à la carte+-- [1]. It supports (higher-order) functors with 0 or more functorial parameters+-- and additional non-functorial parameters, all with a uniform interface. -- -- \[1\] W. Swierstra. Data Types à la Carte. --       /Journal of Functional Programming/, 18(4):423-436, 2008, --       <http://dx.doi.org/10.1017/S0956796808006758>.+--+-- (This module is preferably used with the GHC extensions @DataKinds@ and+-- @PolyKinds@.)+--+-- = Usage+--+-- Compared to traditional data types à la carte, an extra poly-kinded parameter+-- has been added to ':+:' and to the parameters of ':<:'. Standard data types à+-- la carte is obtained by setting this parameter to @()@. That gives us the+-- following type for 'Inl':+--+-- @`Inl` :: h1 () a -> (h1 `:+:` h2) () a@+--+-- Here, @h1 ()@ and @(h1 `:+:` h2) ()@ are functors.+--+-- By setting the extra parameter to a functor @f :: * -> *@, we obtain this+-- type:+--+-- @`Inl` :: h1 f a -> (h1 `:+:` h2) f a@+--+-- This makes @h1@ and @(h1 `:+:` h2)@ higher-order functors.+--+-- Finally, by setting the parameter to a type-level pair of functors+-- @'(f,g) :: (* -> *, * -> *)@, we obtain this type:+--+-- @`Inl` :: h1 '(f,g) a -> (h1 `:+:` h2) '(f,g) a@+--+-- This makes @h1@ and @(h1 `:+:` h2)@ higher-order bi-functors.+--+-- Alternatively, we can represent all three cases above using heterogeneous+-- lists of functors constructed using @'(,)@ and terminated by @()@:+--+-- @+-- `Inl` :: h1 ()           a -> (h1 `:+:` h2) ()           a  -- functor+-- `Inl` :: h1 '(f,())      a -> (h1 `:+:` h2) '(f,())      a  -- higher-order functor+-- `Inl` :: h1 '(f,'(g,())) a -> (h1 `:+:` h2) '(f,'(g,())) a  -- higher-order bi-functor+-- @+--+-- This view is taken by the classes 'HFunctor' and 'HBifunctor'. An 'HFunctor'+-- takes a parameter of kind @(* -> *, k)@; i.e. it has /at least/ one+-- functorial parameter. A 'HBiFunctor' takes a parameter of kind+-- @(* -> *, (* -> *, k))@; i.e. it has /at least/ two functorial parameters.+--+-- = Aliases for parameter lists+--+-- To avoid ugly types such as @'(f,'(g,()))@, this module exports the synonyms+-- 'Param0', 'Param1', 'Param2', etc. for parameter lists up to size 4. These+-- synonyms allow the module to be used without the @DataKinds@ extension.+--+-- = Extra type parameters+--+-- Recall that an 'HFunctor' takes a parameter of kind @(* -> *, k)@, and an+-- 'HBifunctor' takes a parameter of kind @(* -> *, (* -> *, k))@. Since @k@ is+-- polymorphic, it means that it is possible to add extra parameters in place of+-- @k@.+--+-- For example, a user can define the following type representing addition in+-- some language:+--+-- @+-- data Add fs a where+--   Add :: (`Num` a, pred a) => f a -> f a -> Add (`Param2` f pred) a+--+-- instance `HFunctor` Add where+--   `hfmap` f (Add a b) = Add (f a) (f b)+-- @+--+-- Here, @Add@ has a functorial parameter @f@, and an extra non-functorial+-- parameter @pred@ that provides a constraint for the type @a@.+--+-- An obvious alternative would have been to just make @pred@ a separate+-- parameter to @Add@:+--+-- @+-- data Add pred fs a where+--   Add :: (`Num` a, pred a) => f a -> f a -> Add pred (`Param1` f) a+--+-- instance `HFunctor` (Add pred) where+--   `hfmap` f (Add a b) = Add (f a) (f b)+-- @+--+-- However, this has the disadvantage of being hard to use together with the+-- ':<:' class. For example, we might want to define the following \"smart+-- constructor\" for @Add@:+--+-- @+-- mkAdd :: (`Num` a, pred a, Add pred `:<:` h) => f a -> f a -> h (`Param1` f) a+-- mkAdd a b = `inj` (Add a b)+-- @+--+-- Unfortunately, the above type is ambiguous, because @pred@ is completely+-- free. Assuming that @h@ is a type of the form @(... `:+:` Add `Show` `:+:` ...)@,+-- we would like to infer @(pred ~ `Show`)@, but this would require extra+-- machinery, such as a type family that computes @pred@ from @h@.+--+-- By putting @pred@ in the parameter list, we avoid the above problem. We also+-- get the advantage that the same @pred@ parameter is distributed to all types+-- in a sum constructed using ':+:'. This makes it easier to, for example,+-- change the @pred@ parameter uniformly throughout an expression.  module Data.ALaCarte where    -- | Coproducts-data (f :+: g) a b-    = Inl (f a b)-    | Inr (g a b)+data (h1 :+: h2) fs a+    = Inl (h1 fs a)+    | Inr (h2 fs a) #if  __GLASGOW_HASKELL__>=708   deriving (Functor) #endif@@ -33,10 +133,10 @@  -- | 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+class sub :<: sup   where-    inj :: f a b -> g a b-    prj :: g a b -> Maybe (f a b)+    inj :: sub fs a -> sup fs a+    prj :: sup fs a -> Maybe (sub fs a)  instance {-# OVERLAPPING #-} (f :<: f)   where@@ -59,10 +159,46 @@ class HFunctor h   where     -- | Higher-order 'fmap'-    hfmap :: (forall b . m b -> n b) -> h m a -> h n a+    hfmap :: (forall b . f b -> g b) -> h '(f,fs) a -> h '(g,fs) 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)++-- | Higher-order bi-functors+class HFunctor h => HBifunctor h+  where+    -- | Higher-order \"bimap\"+    hbimap :: (Functor f, Functor g)+        => (forall b . f b -> g b)+        -> (forall b . i b -> j b)+        -> h '(f,'(i,fs)) a+        -> h '(g,'(j,fs)) a++instance (HBifunctor h1, HBifunctor h2) => HBifunctor (h1 :+: h2)+  where+    hbimap f g (Inl i) = Inl (hbimap f g i)+    hbimap f g (Inr i) = Inr (hbimap f g i)++++--------------------------------------------------------------------------------+-- * Parameter lists+--------------------------------------------------------------------------------++-- | Empty parameter list+type Param0 = ()++-- | Singleton parameter list+type Param1 a = '(a,Param0)++-- | Two-element parameter list+type Param2 a b = '(a, Param1 b)++-- | Three-element parameter list+type Param3 a b c = '(a, Param2 b c)++-- | Four-element parameter list+type Param4 a b c d = '(a, Param3 b c d) 

@@ -0,0 +1,7 @@+import qualified Simple+import qualified Advanced++main = do+    Simple.main+    Advanced.main+