-- Hoogle documentation, generated by Haddock
-- See Hoogle, http://www.haskell.org/hoogle/
-- | An alternative to monads
--
-- This "control-dsl" package is a toolkit to create extensible Domain
-- Specific Languages in do-notation.
--
-- See Control.Dsl for more information.
@package control-dsl
@version 0.2.0.2
module Control.Dsl.PolyCont
-- | A use case of an ad-hoc polymorphic delimited continuation.
--
-- Note that a PolyCont is not a polymorphic delimited
-- continuation, since a PolyCont does not support answer type
-- modification.
class PolyCont k r a
-- | Run as a CPS function .
runPolyCont :: PolyCont k r a => k r' a -> (a -> r) -> r
module Control.Dsl.Monadic
-- | This Monadic keyword extracts the monadic value of a monadic
-- expression.
newtype Monadic m r a
Monadic :: (m a) -> Monadic m r a
instance GHC.Base.Monad m => Control.Dsl.PolyCont.PolyCont (Control.Dsl.Monadic.Monadic m) (m b) a
module Control.Dsl.Empty
data Empty r a
[Empty] :: Empty r Void
-- | Return an empty a, similar to empty.
--
-- This empty function aims to be used as the last statement of a
-- do block.
empty :: PolyCont Empty a Void => a
instance GHC.Base.Alternative m => Control.Dsl.PolyCont.PolyCont Control.Dsl.Empty.Empty (m a) Data.Void.Void
module Control.Dsl.Return
data Return r' r a
[Return] :: r' -> Return r' r Void
-- | Lift r to the answer type, similar to return.
--
-- This return function aims to be used as the last statement of a
-- do block.
--
-- When return is present in a nested do block for
-- when or unless, if the r is not
-- (), it will create a Cont that performs early
-- return, skipping the rest statements of the outer do
-- notation.
--
-- Examples
--
--
-- >>> :set -XTypeOperators
--
-- >>> :set -XRebindableSyntax
--
-- >>> import Prelude hiding ((>>), (>>=), return, fail)
--
-- >>> import Control.Dsl
--
-- >>> import Control.Dsl.Return
--
-- >>> import Control.Dsl.Yield
--
-- >>> import Control.Dsl.Cont
--
-- >>> import Control.Dsl.Empty
--
--
--
-- >>> :{
-- earlyGenerator :: Bool -> Cont [String] Integer
-- earlyGenerator earlyReturn = do
-- Yield "inside earlyGenerator"
-- when earlyReturn $ do
-- Yield "early return"
-- return 1
-- Yield "normal return"
-- return 0
-- :}
--
--
--
-- >>> :{
-- earlyGeneratorTest :: [String]
-- earlyGeneratorTest = do
-- Yield "before earlyGenerator"
-- i <- earlyGenerator True
-- Yield "after earlyGenerator"
-- Yield $ "the return value of earlyGenerator is " ++ show i
-- empty
-- :}
--
--
--
-- >>> earlyGeneratorTest
-- ["before earlyGenerator","inside earlyGenerator","early return","after earlyGenerator","the return value of earlyGenerator is 1"]
--
return :: PolyCont Return r' r Void => r' -> r
-- | Lift an IOError to the answer type, similar to fail.
--
-- This fail function aims to be used as the last statement of a
-- do block.
fail :: PolyCont Return IOError r Void => String -> r
instance Control.Dsl.PolyCont.PolyCont (Control.Dsl.Return.Return r) r Data.Void.Void
instance GHC.Base.Applicative m => Control.Dsl.PolyCont.PolyCont (Control.Dsl.Return.Return r) (m r) Data.Void.Void
module Control.Dsl.Cont
-- | A type alias to Cont for a deeply nested delimited
-- continuation.
--
-- Examples
--
--
-- >>> :set -XTypeOperators
--
-- >>> :set -XRebindableSyntax
--
-- >>> import Prelude hiding ((>>), (>>=), return, fail)
--
-- >>> import Control.Dsl
--
-- >>> import Control.Dsl.Yield
--
-- >>> import Control.Dsl.Empty
--
-- >>> :{
-- f :: IO () !! [Integer] !! [String] !! [Double]
-- f = do
-- Yield "foo"
-- Yield 0.5
-- Yield 42
-- empty
-- :}
--
type !! = Cont
newtype Cont r a
Cont :: (a -> r) -> r -> Cont r a
[runCont] :: Cont r a -> (a -> r) -> r
when :: Bool -> Cont r () -> Cont r ()
unless :: () => Bool -> Cont r () -> Cont r ()
guard :: PolyCont Empty r Void => Bool -> Cont r ()
instance Control.Dsl.PolyCont.PolyCont k r a => Control.Dsl.PolyCont.PolyCont k (Control.Dsl.Cont.Cont r a') a
instance Control.Dsl.PolyCont.PolyCont (Control.Dsl.Return.Return r) (Control.Dsl.Cont.Cont r' r) Data.Void.Void
instance Control.Dsl.PolyCont.PolyCont Control.Dsl.Empty.Empty r Data.Void.Void => Control.Dsl.PolyCont.PolyCont Control.Dsl.Empty.Empty (Control.Dsl.Cont.Cont r a) Data.Void.Void
module Control.Dsl.Shift
-- | A keyword to extract the value of a CPS function .
newtype Shift r' r a
Shift :: ((a -> r') -> r') -> Shift r' r a
instance Control.Dsl.PolyCont.PolyCont (Control.Dsl.Shift.Shift r) r a
module Control.Dsl.State.Put
data Put s r a
[Put] :: s -> Put s r ()
instance Control.Dsl.PolyCont.PolyCont (Control.Dsl.State.Put.Put s) (Control.Dsl.State.State.State s r) ()
module Control.Dsl.State.Get
data Get r a
[Get] :: forall s r. Get r s
instance Control.Dsl.PolyCont.PolyCont Control.Dsl.State.Get.Get (Control.Dsl.State.State.State s r) s
-- | This module provides keywords to Put and Get the value
-- of multiple mutable variables in a do block.
module Control.Dsl.State
-- | The type that holds states, which is defined as a plain function.
--
-- Examples
--
--
-- >>> :set -XFlexibleContexts
--
-- >>> :set -XTypeApplications
--
-- >>> :set -XRebindableSyntax
--
-- >>> import Prelude hiding ((>>), (>>=), return, fail)
--
-- >>> import Control.Dsl
--
-- >>> import Control.Dsl.Cont
--
-- >>> import Control.Dsl.Shift
--
-- >>> import Control.Dsl.State
--
-- >>> import Data.Sequence (Seq, (|>))
--
-- >>> import qualified Data.Sequence
--
-- >>> import Data.Foldable
--
--
-- The following append function Gets a Seq
-- String state, appends s to the Seq, and
-- Puts the new Seq to the updated state.
--
--
-- >>> :{
-- append s = do
-- buffer <- Get @(Seq String)
-- Put $ buffer |> s
-- Cont ($ ())
-- :}
--
--
-- ($ ()) creates a CPS function , which can be then converted
-- to Conts.
--
-- A formatter appends String to its internal
-- buffer, and return the concatenated buffer.
--
--
-- >>> :{
-- formatter = do
-- append "x="
-- d <- Get @Double
-- append $ show d
-- append ",y="
-- i <- Get @Integer
-- append $ show i
-- buffer <- Get @(Seq String)
-- return $ concat buffer
-- :}
--
--
--
-- >>> x = 0.5 :: Double
--
-- >>> y = 42 :: Integer
--
-- >>> initialBuffer = Data.Sequence.empty :: Seq String
--
-- >>> formatter x y initialBuffer :: String
-- "x=0.5,y=42"
--
--
-- Note that formatter accepts arbitrary order of the
-- parameters, or additional unused parameters.
--
--
-- >>> formatter "unused parameter" initialBuffer y x :: String
-- "x=0.5,y=42"
--
type State = (->)
-- | This module contains the Yield data type and related
-- Dsl instances.
--
-- The Yield data type can be used to create generators, similar
-- to the yield keyword in C#, Python, and ECMAScript.
module Control.Dsl.Yield
-- | This Yield keyword produces an element in a list generator
--
-- Examples
--
-- randomGenerator is an example to create an xorshift
-- pseudo-random number generator that returns an infinite list of
-- generated numbers.
--
--
-- >>> :set -XTypeApplications
--
-- >>> :set -XRebindableSyntax
--
-- >>> import Prelude hiding ((>>), (>>=), return, fail)
--
-- >>> import Control.Dsl
--
-- >>> import Data.Word
--
-- >>> import Data.Bits
--
-- >>> :{
-- randomGenerator :: Word32 -> [Word32]
-- randomGenerator seed =
-- do let tmp1 = xor seed $ shiftL seed 13
-- let tmp2 = xor tmp1 $ shiftR tmp1 17
-- let tmp3 = xor tmp2 $ shiftL tmp2 5
-- Yield tmp3
-- randomGenerator tmp3
-- :}
--
--
--
-- >>> take 5 $ randomGenerator 2463534242
-- [723471715,2497366906,2064144800,2008045182,3532304609]
--
data Yield x r a
[Yield] :: x -> Yield x r ()
instance Control.Dsl.PolyCont.PolyCont (Control.Dsl.Yield.Yield x) [x] ()
instance Control.Dsl.PolyCont.PolyCont (Control.Dsl.Yield.Yield x) (Control.Dsl.Cont.Cont r [x]) ()
-- | This Control.Dsl module and its submodules provide a toolkit to
-- create extensible Domain Specific Languages in do-notation.
--
-- A DSL do block contains heterogeneous statements from
-- different vendors. A statement can be defined as a GADT, interpreted
-- by a Dsl type class instance, either effectfully or purely.
--
-- A DSL do block is abstract. When creating the block, the type
-- class requirements is automatically inferred. Therefore, the data
-- structures and implementation of interpreters can be switched by
-- providing different instances.
--
-- Getting started
--
-- This package provides Dsl type class used in do
-- notation, as a replacement to Monad.
--
-- RebindableSyntax extension is required to enable DSL
-- do notation.
--
--
-- >>> :set -XRebindableSyntax
--
-- >>> import Prelude hiding ((>>), (>>=), return, fail)
--
-- >>> import Control.Dsl
--
--
-- DSL model
--
-- Suppose you are creating a DSL for console IO, you need to define some
-- keywords allowed in the DSL.
--
-- Each keyword is a GADT:
--
--
-- >>> data MaxLengthConfig r a where MaxLengthConfig :: MaxLengthConfig r Int
--
-- >>> data GetLine r a where GetLine :: GetLine r String
--
-- >>> data PutStrLn r a where PutStrLn :: String -> PutStrLn r ()
--
--
-- DSL do block
--
-- Then those keywords can be used in do blocks:
--
--
-- >>> :{
-- dslBlock = do
-- maxLength <- MaxLengthConfig
-- line1 <- GetLine
-- line2 <- GetLine
-- when (length line1 + length line2 > maxLength) $ do
-- PutStrLn "The input is too long"
-- fail "Illegal input"
-- PutStrLn ("The input is " ++ line1 ++ " and " ++ line2)
-- return ()
-- :}
--
--
-- The above dslBlock function creates an abstract code block of
-- DSL from keywords and some built-in control flow functions.
--
-- Keywords and the result statement return and fail are
-- ad-hoc polymorphic delimited continuations, interpreted by
-- PolyCont, which can be automatically inferred:
--
--
-- >>> :type dslBlock
-- dslBlock
-- :: (PolyCont (Return IOError) r Void, PolyCont (Return ()) r Void,
-- PolyCont MaxLengthConfig r Int, PolyCont GetLine r [Char],
-- PolyCont PutStrLn r ()) =>
-- r
--
--
-- Creating a pure interpreter
--
-- The type r varies from different PolyCont instances.
-- By defining PolyCont instances for PureInterpreter,
-- you can make r be a PureInterpreter:
--
--
-- >>> type PureInterpreter = Int -> [String] -> Cont [String] IOError
--
--
--
-- >>> :{
-- instance PolyCont MaxLengthConfig PureInterpreter Int where
-- runPolyCont MaxLengthConfig = runPolyCont Get
-- :}
--
--
--
-- >>> :{
-- instance PolyCont PutStrLn PureInterpreter () where
-- runPolyCont (PutStrLn s) = runPolyCont (Yield s)
-- :}
--
--
--
-- >>> :{
-- instance PolyCont (Return ()) PureInterpreter Void where
-- runPolyCont (Return ()) = runPolyCont Empty
-- :}
--
--
-- The above three PolyCont instances are implemented as
-- forwarders to other existing keywords.
--
--
-- >>> :{
-- instance PolyCont GetLine PureInterpreter String where
-- runPolyCont k = runCont $ do
-- x : xs <- Get @[String]
-- Put xs
-- return x
-- :}
-- ...
--
--
-- The PolyCont instance for GetLine is implemented as a
-- Cont that contains a DSL do block of atomic
-- statements.
--
-- Running the DSL purely
--
--
-- >>> runPurely = dslBlock :: PureInterpreter
--
--
--
-- >>> errorHandler e = ["(handled) " ++ show e]
--
-- >>> runCont (runPurely 80 ["LINE_1", "LINE_2"]) errorHandler
-- ["The input is LINE_1 and LINE_2"]
--
--
--
-- >>> longInput = [replicate 40 '*', replicate 41 '*']
--
-- >>> runCont (runPurely 80 longInput) errorHandler
-- ["The input is too long","(handled) user error (Illegal input)"]
--
--
--
-- >>> runCont (runPurely 80 ["ONE_LINE"]) errorHandler
-- ["(handled) user error (Pattern match failure in do expression at <interactive>..."]
--
--
-- Creating an effectful interpreter
--
-- Alternatively, dslBlock can run effectfully by providing
-- effectful PolyCont instances.
--
--
-- >>> type EffectfulInterpreter = Handle -> IO ()
--
--
--
-- >>> :{
-- instance PolyCont GetLine EffectfulInterpreter String where
-- runPolyCont GetLine = runCont $ do
-- h <- Get
-- line <- Monadic (hGetLine h)
-- return line
-- :}
--
--
-- Monadic is a built-in keyword to perform old-fashioned monadic
-- action in a DSL do block.
--
-- Other keywords can be used together with Monadic. No monad
-- transformer is required.
--
--
-- >>> :{
-- instance PolyCont MaxLengthConfig (IO ()) Int where
-- runPolyCont MaxLengthConfig f = f 80
-- :}
--
--
--
-- >>> :{
-- instance PolyCont PutStrLn (IO ()) () where
-- runPolyCont (PutStrLn s) = (Prelude.>>=) (putStrLn s)
-- :}
--
--
--
-- >>> :{
-- instance PolyCont (Return IOError) (IO ()) Void where
-- runPolyCont (Return e) _ = hPutStrLn stderr (show e)
-- :}
--
--
-- Running the DSL effectfully
--
--
-- >>> runEffectfully = dslBlock :: EffectfulInterpreter
--
--
--
-- >>> :{
-- withSystemTempFile "tmp-input-file" $ \_ -> \h -> do
-- Monadic $ hPutStrLn h "LINE_1"
-- Monadic $ hPutStrLn h "LINE_2"
-- Monadic $ hSeek h AbsoluteSeek 0
-- runEffectfully h
-- :}
-- The input is LINE_1 and LINE_2
--
module Control.Dsl
-- | Witnesses a use case of a statement in a do block.
--
-- Allowed statements in DSL do blocks
--
-- Statements in a DSL do block is a delimited continuation
-- (except the last statement), which can be a GADT keyword, a control
-- flow operator.
--
-- The last statement is the final result of the do block, or
-- the answer type of other delimited continuation statements.
--
-- TODO: table
--
-- Don't create custom instances of Dsl for statement. Instead,
-- create PolyCont instances for your custom GADT keywords.
--
-- Examples
--
--
-- >>> :set -XGADTs
--
-- >>> :set -XMultiParamTypeClasses
--
-- >>> :set -XFlexibleInstances
--
-- >>> :set -XFlexibleContexts
--
-- >>> :set -XRebindableSyntax
--
-- >>> :set -XTypeApplications
--
-- >>> import qualified Prelude
--
-- >>> import Prelude hiding ((>>), (>>=), return, fail)
--
-- >>> import Control.Dsl
--
-- >>> import Control.Dsl.State.Get
--
-- >>> import Control.Dsl.Yield
--
-- >>> import Control.Dsl.Return
--
-- >>> import Data.Void
--
--
--
-- >>> :{
-- f = do
-- Yield "foo"
-- config <- Get @Bool
-- when config $ do
-- Yield "bar"
-- return ()
-- return "baz"
-- :}
--
--
-- f is a do block that contains keywords of
-- Get, Yield, and return. With the help of built-in
-- PolyCont instances for those keywords, f can be used
-- as a function that accepts a boolean parameter.
--
--
-- >>> f False :: [String]
-- ["foo","baz"]
--
--
--
-- >>> f True :: [String]
-- ["foo","bar","baz"]
--
--
-- In fact, f can be any type as long as PolyCont
-- instances for involved keywords are provided.
--
--
-- >>> :type f
-- f :: (PolyCont (Yield [Char]) r (),
-- PolyCont (Return [Char]) r Void, PolyCont Get r Bool) =>
-- r
--
--
-- For example, f can be interpreted as an impure IO
-- (), providing the following instances:
--
--
-- >>> :{
-- instance PolyCont (Yield String) (IO ()) () where
-- runPolyCont (Yield a) = (Prelude.>>=) (putStrLn $ "Yield " ++ a)
-- instance PolyCont Get (IO ()) Bool where
-- runPolyCont Get f = putStrLn "Get" Prelude.>> f False
-- instance PolyCont (Return String) (IO ()) Void where
-- runPolyCont (Return r) _ = putStrLn $ "Return " ++ r
-- :}
--
--
--
-- >>> f :: IO ()
-- Yield foo
-- Get
-- Return baz
--
class Dsl k r a
-- | The implementation of <- statements in a do
-- block, which forwards to runCont if k is Cont,
-- otherwise forwards to runPolyCont from PolyCont.
(>>=) :: Dsl k r a => k r a -> a -> r -> r
(=<<) :: Dsl k r a => a -> r -> k r a -> r
(>=>) :: Dsl k r a => t -> k r a -> a -> r -> t -> r
(<=<) :: Dsl k r a => t -> k r a -> a -> r -> t -> r
-- | The implementation of statements with no value in a do block.
(>>) :: Dsl k r b => k r b -> r -> r
forever :: Dsl k r a => k r a -> r
ifThenElse :: () => Bool -> p -> p -> p
-- | Lift r to the answer type, similar to return.
--
-- This return function aims to be used as the last statement of a
-- do block.
--
-- When return is present in a nested do block for
-- when or unless, if the r is not
-- (), it will create a Cont that performs early
-- return, skipping the rest statements of the outer do
-- notation.
--
-- Examples
--
--
-- >>> :set -XTypeOperators
--
-- >>> :set -XRebindableSyntax
--
-- >>> import Prelude hiding ((>>), (>>=), return, fail)
--
-- >>> import Control.Dsl
--
-- >>> import Control.Dsl.Return
--
-- >>> import Control.Dsl.Yield
--
-- >>> import Control.Dsl.Cont
--
-- >>> import Control.Dsl.Empty
--
--
--
-- >>> :{
-- earlyGenerator :: Bool -> Cont [String] Integer
-- earlyGenerator earlyReturn = do
-- Yield "inside earlyGenerator"
-- when earlyReturn $ do
-- Yield "early return"
-- return 1
-- Yield "normal return"
-- return 0
-- :}
--
--
--
-- >>> :{
-- earlyGeneratorTest :: [String]
-- earlyGeneratorTest = do
-- Yield "before earlyGenerator"
-- i <- earlyGenerator True
-- Yield "after earlyGenerator"
-- Yield $ "the return value of earlyGenerator is " ++ show i
-- empty
-- :}
--
--
--
-- >>> earlyGeneratorTest
-- ["before earlyGenerator","inside earlyGenerator","early return","after earlyGenerator","the return value of earlyGenerator is 1"]
--
return :: PolyCont Return r' r Void => r' -> r
-- | Lift an IOError to the answer type, similar to fail.
--
-- This fail function aims to be used as the last statement of a
-- do block.
fail :: PolyCont Return IOError r Void => String -> r
when :: Bool -> Cont r () -> Cont r ()
unless :: () => Bool -> Cont r () -> Cont r ()
guard :: PolyCont Empty r Void => Bool -> Cont r ()