diff --git a/Cascade.cabal b/Cascade.cabal new file mode 100644 --- /dev/null +++ b/Cascade.cabal @@ -0,0 +1,89 @@ +-- Initial Cascade.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +-- The name of the package. +name: Cascade + +-- The package version. See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented. +-- http://www.haskell.org/haskellwiki/Package_versioning_policy +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.1.0.0 + +-- A short (one-line) description of the package. +synopsis: Playing with reified categorical composition + +-- A longer description of the package. +-- description: + +-- URL for the project homepage or repository. +homepage: http://github.com/rampion/Cascade + +-- The license under which the package is released. +license: PublicDomain + +-- The file containing the license text. +license-file: LICENSE + +-- The package author(s). +author: Noah Luck Easterly + +-- An email address to which users can send suggestions, bug reports, and +-- patches. +maintainer: noah.easterly@gmail.com + +-- A copyright notice. +-- copyright: + +category: Control + +build-type: Simple + +-- Extra files to be distributed with the package, such as examples or a +extra-source-files: README.md + +-- Constraint on the version of Cabal needed to build this package. +cabal-version: >=1.10 + + +library + -- Modules exported by the library. + exposed-modules: Cascade + , Cascade.Debugger + , Cascade.Examples + , Cascade.Product + , Cascade.Sum + , Cascade.Util.ListKind + , Cascade.Operators + + -- Modules included in this library but not exported. + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + other-extensions: KindSignatures + , TypeOperators + , DataKinds + , GADTs + , RankNTypes + , ConstraintKinds + , FlexibleContexts + , FlexibleInstances + , MultiParamTypeClasses + , PolyKinds + , TypeFamilies + , UndecidableInstances + + -- Other library packages from which modules are imported. + build-depends: base >=4.7 && <4.8 + , comonad >=4.2 && <4.3 + , mtl >=2.2 && <2.3 + , ghc-prim >=0.3 && <0.4 + , void >= 0.6 + + -- Directories containing source files. + -- hs-source-dirs: + + -- Base language which the package is written in. + default-language: Haskell2010 diff --git a/Cascade.hs b/Cascade.hs new file mode 100644 --- /dev/null +++ b/Cascade.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +module Cascade where +import Cascade.Util.ListKind (Last) + +import Control.Arrow (Kleisli(..)) +import Control.Category (Category(..), (>>>)) +import Control.Comonad (Cokleisli(..), Comonad(..)) +import Control.Monad.Identity (Identity(..)) +import Prelude hiding (id, (.)) + +-- reified categorical composition +data CascadeC (c :: t -> t -> *) (ts :: [t]) where + (:>>>) :: c x y -> CascadeC c (y ': zs) -> CascadeC c (x ': y ': zs) + Done :: CascadeC c '[t] +infixr 1 :>>> + +-- transform the underlying category used in a cascade +transform :: (forall a b. c a b -> c' a b) -> CascadeC c ts -> CascadeC c' ts +transform _ Done = Done +transform g (f :>>> fs) = g f :>>> transform g fs + +-- compress into a function +cascade :: Category c => CascadeC c (t ': ts) -> c t (Last (t ': ts)) +cascade Done = id +cascade (f :>>> fs) = f >>> cascade fs + +-- specialize to functions +type Cascade = CascadeC (->) + +-- specialize to monads +type CascadeM m = CascadeC (Kleisli m) +(>=>:) :: (x -> m y) -> CascadeM m (y ': zs) -> CascadeM m (x ': y ': zs) +(>=>:) f cm = Kleisli f :>>> cm +infixr 1 >=>: + +cascadeM :: Monad m => CascadeM m (t ': ts) -> t -> m (Last (t ': ts)) +cascadeM = runKleisli . cascade + +-- transform a simple cascade to and from a Kleisli cascade +unwrapM :: CascadeM Identity ts -> Cascade ts +unwrapM = transform $ \f -> runIdentity . runKleisli f + +wrapM :: Monad m => Cascade ts -> CascadeM m ts +wrapM = transform $ \f -> Kleisli $ return . f + +-- specialize to comonads +type CascadeW w = CascadeC (Cokleisli w) +(=>=:) :: (w x -> y) -> CascadeW w (y ': zs) -> CascadeW w (x ': y ': zs) +(=>=:) f cw = Cokleisli f :>>> cw +infixr 1 =>=: + +cascadeW :: Comonad w => CascadeW w (t ': ts) -> w t -> Last (t ': ts) +cascadeW = runCokleisli . cascade + +-- transform a simple cascade to and from a Cokleisli cascade +unwrapW :: CascadeW Identity ts -> Cascade ts +unwrapW = transform $ \f -> runCokleisli f . Identity + +wrapW :: Comonad w => Cascade ts -> CascadeW w ts +wrapW = transform $ \f -> Cokleisli $ f . extract diff --git a/Cascade/Debugger.hs b/Cascade/Debugger.hs new file mode 100644 --- /dev/null +++ b/Cascade/Debugger.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} -- to use All Show zs +module Cascade.Debugger where +import Cascade +import Cascade.Util.ListKind + +import Control.Arrow +import Control.Category +import Prelude hiding (id, (.)) +import GHC.Prim (Constraint) + + +data DebuggerM (m :: * -> *) (past :: [*]) (current :: *) (future :: [*]) where + + Begin :: (a -> m (DebuggerM m '[a] b cs)) + -> DebuggerM m '[] a (b ': cs) + + Break :: (a -> m (DebuggerM m (a ': z ': ys) b cs)) + -> DebuggerM m ys z (a ': b ': cs) + -> z + -> a + -> DebuggerM m (z ': ys) a (b ': cs) + + End :: DebuggerM m ys z '[a] + -> z + -> a + -> DebuggerM m (z ': ys) a '[] + +instance (All Show zs, All Show bs, Show a) => Show (DebuggerM m zs a bs) where + showsPrec p d = case d of + Begin _ -> showString "Begin" + Break _ _ z a -> showParen (p > 10) $ showString "Break" . showIO z a + End _ z a -> showParen (p > 10) $ showString "End " . showIO z a + where showIO z a = showString " { given = ". showsPrec 11 z . + showString ", returned = " . showsPrec 11 a . + showString " }" + +printHistory :: (All Show zs, All Show bs, Show a) => DebuggerM m zs a bs-> IO () +printHistory d@(Begin _ ) = print d +printHistory d@(Break _ _ _ _) = print d >> printHistory (back d) +printHistory d@(End _ _ _) = print d >> printHistory (back d) + +given :: DebuggerM m (z ': ys) a bs -> z +given (Break _ _ z _) = z +given (End _ z _) = z + +returned :: DebuggerM m (z ': ys) a bs -> a +returned (Break _ _ _ a) = a +returned (End _ _ a) = a + +back :: DebuggerM m (z ': ys) a bs -> DebuggerM m ys z (a ': bs) +back (Break _ d _ _) = d +back (End d _ _) = d + +redo :: DebuggerM m (a ': z ': ys) b cs -> m (DebuggerM m (a ': z ': ys) b cs) +redo = step . back + +redoWith :: a -> DebuggerM m (a ': zs) b cs -> m (DebuggerM m (a ': zs) b cs) +redoWith x = use x . back + +use :: a -> DebuggerM m zs a (b ': cs) -> m (DebuggerM m (a ': zs) b cs) +use a (Begin f ) = f a +use a (Break f _ _ _) = f a + +step :: DebuggerM m (z ': ys) a (b ': cs) -> m (DebuggerM m (a ': z ': ys) b cs) +step (Break f _ _ a) = f a + +debugM :: Monad m => CascadeM m (a ': b ': cs) -> DebuggerM m '[] a (b ': cs) +debugM (f :>>> fs) = let d = Begin (go f fs d) in d + where go :: Monad m + => Kleisli m a b + -> CascadeM m (b ': cs) + -> DebuggerM m zs a (b ': cs) + -> (a -> m (DebuggerM m (a ': zs) b cs)) + go (Kleisli f) Done d a = do + b <- f a + return $ End d a b + go (Kleisli f) (f' :>>> fs) d a = do + b <- f a + let d' = Break (go f' fs d') d a b + return d' diff --git a/Cascade/Examples.hs b/Cascade/Examples.hs new file mode 100644 --- /dev/null +++ b/Cascade/Examples.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +module Cascade.Examples where + +import Cascade +import Cascade.Debugger + +import Control.Category +import Control.Monad +import Data.Char (toUpper) +import Prelude hiding (id, (.)) +import System.Environment (getEnv, setEnv, getProgName) + +-- example funcitonal cascades +fc, gc :: Cascade '[String, Int, Double, Double] +fc = read :>>> + fromIntegral :>>> + (1/) :>>> Done +gc = length :>>> + (2^) :>>> + negate :>>> Done + +-- some example monadic cascades +mc, nc :: CascadeM IO '[ String, (), String, String, () ] +mc = putStr >=>: + const getLine >=>: + return . map toUpper >=>: + putStrLn >=>: Done +nc = setEnv "foo" >=>: + const (return "foo") >=>: + getEnv >=>: + print . length >=>: Done + +-- some example comonadic cascades +wc, vc :: CascadeW ((,) Char) '[ Int, Char, Int, String ] +wc = fst =>=: + fromEnum . snd =>=: + uncurry (flip replicate) =>=: Done +vc = toEnum . snd =>=: + const 5 =>=: + show =>=: Done + +-- run the debugger for the mc cascade all the way to the end +rundmc :: IO (DebuggerM IO '[String, String, (), [Char]] () '[]) +rundmc = debugM >>> use "walk this way\n> " >=> step >=> step >=> step $ mc + +-- alternate using functions from one cascade then the other +zigzag :: CascadeC c ts -> CascadeC c ts -> CascadeC c ts +zigzag Done Done = Done +zigzag (f :>>> fc) (_ :>>> gc) = f :>>> zigzag gc fc diff --git a/Cascade/Operators.hs b/Cascade/Operators.hs new file mode 100644 --- /dev/null +++ b/Cascade/Operators.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +module Cascade.Operators where +import Control.Category (Category(..)) +import Control.Comonad (Comonad(..)) +import Cascade.Util.ListKind +import Cascade + +(#) :: Category c => CascadeC c (t ': ts) -> c t (Last (t ': ts)) +(#) = cascade +infixr 0 # + +(#~) :: Monad m => CascadeM m (t ': ts) -> t -> m (Last (t ': ts)) +(#~) = cascadeM +infixr 0 #~ + +(~#) :: Comonad w => CascadeW w (t ': ts) -> w t -> Last (t ': ts) +(~#) = cascadeW +infixr 0 ~# diff --git a/Cascade/Product.hs b/Cascade/Product.hs new file mode 100644 --- /dev/null +++ b/Cascade/Product.hs @@ -0,0 +1,113 @@ +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE UndecidableInstances #-} -- for RInits +module Cascade.Product where +import Cascade +import Cascade.Util.ListKind + +import Control.Arrow (Kleisli(..)) +import Control.Comonad (Cokleisli(..), Comonad(..), liftW, (=>>)) +import Control.Monad (liftM) +import Control.Monad.Identity (Identity(..)) + +-- Monadic product +-- +-- Mostly equivalent to +-- +-- type family ProductM w ts where +-- ProductM m (a ': as) = (a, m (ProductM m as)) +-- ProductM m '[] = () +-- +-- Made concrete to avoid injective type errors +data ProductM (m :: * -> *) (ts :: [*]) where + None :: ProductM m '[] + (:*) :: a -> m (ProductM m ts) -> ProductM m (a ': ts) +infixr 5 :* + +-- specialize for the Identity monad, since that'll be common +type Product = ProductM Identity +(*:) :: a -> Product ts -> Product (a ': ts) +a *: as = a :* return as +infixr 5 *: + +instance Show (ProductM Identity '[]) where + showsPrec _ None = showString "None" + +instance (Show a, Show (ProductM Identity as)) => Show (ProductM Identity (a ': as)) where + showsPrec p (a :* (Identity as)) = showParen (p > 10) $ showsPrec 5 a . showString " *: " . showsPrec 5 as + +-- Now, ideally, I'd like to be able to lift a `CascadeC c ts` into a chain of +-- transformations between longer and longer `ProductM`s, so when you ultimately +-- ran the cascade, you could generate as much of the intermediate results as +-- you wanted. +-- +-- I think this would require something like +-- +-- replayC0 :: CascadeWM w m '[a] -> CascadeW w '[ ProductM m '[a] ] +-- replayC0 Done = Done +-- +-- replayC1 :: CascadeWM w m '[a,b] -> CascadeW w '[ ProductM m '[a], ProductM m '[a,b] ] +-- replayC1 (f :>>> Done) = unshifts f :>>> Done +-- +-- replayC2 :: CascadeWM w m '[a,b] +-- -> CascadeW w '[ ProductM m '[a], ProductM m '[a,b], ProductM m '[a, b, c] ] +-- replayC2 (f :>>> g :>>> Done) = unshifts f :>>> unshifts g :>>> Done +-- +-- ... +-- +-- replayC :: CascadeWM w m ts -> CascadeW w (Map (ProductM m) (Tail (Inits ts))) +-- replayC Done = Done +-- replayC (f :>>> fs) = unshifts f :>>> replayC fs +-- +-- where `unshifts` has the given arrow simply append its result to the end of +-- the product +-- +-- unshifts :: (w (Last as) -> m b) -> w (ProductM m as) -> ProductM m (Snoc b as) +-- +-- But I haven't gotten this to quite work yet. +-- +-- For one thing, you actually want `replayC` to be polymorphic in the `init` of +-- the type list. You don't care how long the ProductM is you get - you're just +-- skipping to the end. +-- +-- In any case, I suspect this is likely to be slower than normally desired +-- since you have to step all the way through to the end of the `ProductM` each +-- time. Fortunately, the reversed `ProductM Identity` solution is easier and +-- faster + + +-- Given ts = [a,b..z], for any ts' this generates the list of `Product`s +-- +-- [ Product (a : ts'), Product (b : a : ts'), ..., Product (z : ... : b : a : ts') ] +-- +-- Note that the elements of ts are reversed as they are prepended to ts', so +-- the most recently prepended type may be extracted from the front of the `Product` +-- +type family RInitProducts (ts :: [*]) (ts' :: [*]) :: [*] where + RInitProducts (a ': as) ts' = Product (a ': ts') ': RInitProducts as (a ': ts') + RInitProducts '[] ts' = '[] + +-- lift a cokleisli arrow into an arrow on the first element of a product +-- (similar to \f as@(a,_) -> (f a, as) ) +pushes :: Comonad w + => (w y -> x) + -> w (Product (y ': zs)) -> Product (x ': y ': zs) +pushes f wyzs = f wy *: yzs + where wy = liftW (\(y :* _) -> y) wyzs + yzs = extract wyzs + +-- transform a comonadic cascade to cache the partial results seen along the way +recordW :: Comonad w + => CascadeW w (t ': ts) -> CascadeW w (RInitProducts (t ': ts) ts') +recordW Done = Done +recordW (Cokleisli f :>>> fs) = pushes f =>=: recordW fs + +-- specialize for functional cascades +record :: Cascade (t ': ts) -> Cascade (RInitProducts (t ': ts) ts') +record = unwrapW . recordW . wrapW diff --git a/Cascade/Sum.hs b/Cascade/Sum.hs new file mode 100644 --- /dev/null +++ b/Cascade/Sum.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneDeriving #-} +module Cascade.Sum where +import Cascade +import Cascade.Util.ListKind + +import Control.Arrow (Kleisli(..)) +import Control.Comonad (Cokleisli(..), Comonad(..), liftW, (=>>)) +import Control.Monad (liftM) +import Control.Monad.Identity (Identity(..)) +import Data.Void + +-- Comonadic sum +-- +-- Mostly equivalent to +-- +-- type family SumW w ts where +-- SumW w (a ': as) = Either (w a) (SumW w as) +-- SumW w '[] = Void +-- +-- Made concrete to avoid injective type errors +data SumW (w :: * -> *) (ts :: [*]) where + Here :: w a -> SumW w (a ': as) + There :: SumW w as -> SumW w (a ': as) + + +type family SumW' w (ts :: [*]) where + SumW' w ('[]) = Void + SumW' w (a ': as) = Either (w a) (SumW' w as) + +toEither :: SumW w as -> SumW' w as +toEither (Here wa) = Left wa +toEither (There oo) = Right (toEither oo) + +-- specialize for the identity comonad, since that'll be common +type Sum = SumW Identity + +here :: a -> Sum (a ': as) +here = Here . Identity + +there :: Sum as -> Sum (a ': as) +there = There + +instance Show (SumW Identity '[]) where + showsPrec _ _ = error "impossible value of type Sum '[]" + +-- show as "here x", "there.here $ x", "there.there.there.here $ x" to avoid lisping +instance (Show a, Show (SumW Identity as)) => Show (SumW Identity (a ': as)) where + showsPrec (-1) (Here (Identity a)) = showString "here $ " . showsPrec 0 a + showsPrec (-1) (There as) = showString "there." . showsPrec (-1) as + showsPrec p (Here (Identity a)) = showParen (p > 10) $ showString "here " . showsPrec 11 a + showsPrec p (There as) = showParen True $ showString "there." . showsPrec (-1) as + +-- This could be more simply expressed as +-- +-- type TailSumsW w ts = Map (SumW w) (Init (Tails ts)) +-- +-- however, GHC can't quite figure out the equivalences we need +-- +-- Could not deduce (Map (SumW w) (Init ((y : zs) : Tails zs)) ~ (SumW w (y : zs) : zs0)) +-- +-- XXX: This type family is actually more restrictive than we need - we should +-- actually use `SumW w (a ': Concat as bs)`, as we can pass through any b +-- values untouched. Haven't gotten that to work yet though. +type family TailSumsW (w :: * -> *) (ts :: [*]) :: [*] where + TailSumsW w '[] = '[] + TailSumsW w (a ': as) = SumW w (a ': as) ': TailSumsW w as +type TailSums ts = TailSumsW Identity ts + +-- lift a kleisli arrow into an arrow on the first element of a sum (if given) +-- (similar to \f -> either f id) +pops :: Monad m + => (w x -> m (w y)) + -> SumW w (x ': y ': zs) -> m (SumW w (y ': zs)) +pops _ (There oo) = return oo +pops f (Here wx) = liftM Here $ f wx + +-- transform a categorical cascade into a monadic cascade, resumable from any +-- point in the computation (by passing the proper sum value as input) +resumeC :: Monad m + => (forall a b. c a b -> w a -> m (w b)) + -> CascadeC c ts + -> CascadeM m (TailSumsW w ts) +resumeC over Done = Done +resumeC over (f :>>> fs) = pops (over f) >=>: resumeC over fs + +-- specialize to monadic cascades +resumeM :: Monad m => CascadeM m ts -> CascadeM m (TailSums ts) +resumeM = resumeC $ \c -> liftM Identity . runKleisli c . runIdentity + +-- specialize to comonadic cascades +resumeW :: Comonad w => CascadeW w ts -> Cascade (TailSumsW w ts) +resumeW = unwrapM . resumeC (\c -> Identity . (=>> runCokleisli c)) + +-- specialize to functional cascades +resume :: Cascade ts -> Cascade (TailSums ts) +resume = unwrapM . resumeC (\c -> fmap (Identity . c)) + +-- unwrap the output for the user +-- resume' :: Cascade ts -> Cascade (Snoc (TailSums ts (Last ts)) +-- resume' fs = resume fs diff --git a/Cascade/Util/ListKind.hs b/Cascade/Util/ListKind.hs new file mode 100644 --- /dev/null +++ b/Cascade/Util/ListKind.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} -- for RInits +module Cascade.Util.ListKind where +import GHC.Prim (Constraint) + +-- type level version of all :: (a -> Bool) -> [a] -> Bool +type family All (c :: a -> Constraint) (xs :: [a]) :: Constraint where + All c '[] = () + All c (a ': as) = (c a, All c as) + +-- type level version of last :: [a] -> a +type family Last (ts :: [a]) :: a where + Last '[a] = a + Last (a ': as) = Last as + +-- type level version of map :: (a -> b) -> [a] -> [b] +type family Map (f :: a -> b) (ts :: [a]) :: [b] where + Map f '[] = '[] + Map f (a ': as) = f a ': Map f as + +-- type level version of tails :: [a] -> [[a]] +type family Tails (as :: [a]) :: [[a]] where + Tails '[] = '[ '[] ] + Tails (a ': as) = (a ': as) ': Tails as + +-- type level version of tail :: [a] -> [a] +type family Tail (as :: [a]) :: [a] where + Tail (a ': as) = as + +-- type level version of init :: [a] -> [a] +type family Init (as :: [a]) :: [a] where + Init '[a] = '[] + Init (a ': as) = a ': Init as + +-- type level version of rinits :: [a] -> [[a]] ; rinits = reverse . inits . reverse +type family RInits (as :: [a]) :: [[a]] where + RInits '[] = '[ '[] ] + RInits (a ': as) = '[] ': Map (Snoc a) (RInits as) + +-- type level version of snoc :: a -> [a] -> [a] ; snoc a = reverse . (a:) . reverse +type family Snoc (x :: a) (xs :: [a]) :: [a] where + Snoc x '[] = '[x] + Snoc x (a ': as) = a ': Snoc x as + +-- type level version of zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] +type family ZipWith (f :: a -> b -> c) (as :: [a]) (bs :: [b]) :: [c] where + ZipWith f '[] '[] = '[] + ZipWith f (a ': as) (b ': bs) = f a b ': ZipWith f as bs + +type family Concat (as :: [a]) (bs :: [a]) :: [a] where + Concat '[] bs = bs + Concat (a ': as) bs = a ': Concat as bs diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,1 @@ +public domain diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,212 @@ +`Cascade`s are collections of composable functions (e.g. `a -> b, b -> c, ... , y -> z`) where the intermediate types are stored in a type level list (e.g. `Cascade [a,b,c,...,y,z]`). + +For example, consider these `Cascade`s: + +```haskell +fc :: Cascade '[String, Int, Double, Double] +fc = read :>>> + fromIntegral :>>> + (1/) :>>> Done + +gc :: Cascade '[String, Int, Double, Double] +gc = length :>>> + (2^) :>>> + negate :>>> Done +``` + +We can convert a cascade into a function easily enough: + +```haskell +λ :m +Cascade.Examples Cascade.Operators +λ fc # "5" +0.2 +λ gc # "20" +-4.0 +``` + +But that's not very inspiring. The real question, [as Christian Conkle put it](http://stackoverflow.com/questions/26593237/what-would-the-type-of-a-list-of-cascading-functions-be#comment41802812_26593534), is "what does such a collection give you over function composition?" + +Because none of the type information has been lost, we can still extract each of the functions that went into the `Cascade` using simple pattern matching. This opens the door to replacing parts of a cascade, or indexing into the cascade with type-level naturals. + +It also lets us do something silly like mix and match two different cascades: + +```haskell +λ zigzag fc gc # "3" -- read >>> (2^) >>> (1/) +0.125 +λ zigzag gc fc # "123456789" -- length >>> fromIntegral >>> negate +-9.0 +``` + +More seriously, we can record the intermediate results of each `Cascade` using a `Product` type as output: + +```haskell +λ :m +Cascade.Product +λ record fc # "5" *: None +0.2 *: 5.0 *: 5 *: "5" *: None +λ record gc # "5" *: None +-2.0 *: 2.0 *: 1 *: "5" *: None +``` + +Or I can resume the computation at some later point rather that the first function in the `Cascade` using a `Sum` type as input: + +```haskell +λ :m +Cascade.Sum +λ resume fc # (there.there.here) 0.2 +here 5.0 +λ resume gc # (there.here) 0 +here (-1.0) +``` + +Or we could do both: + +```haskell +λ resume (record fc) # (there.here) (17 *: "foo" *: None) +here (5.8823529411764705e-2 *: 17.0 *: 17 *: "foo" *: None) +λ record (resume fc) # (there . there $ here 0.25) *: None +here 4.0 *: here 0.25 *: (there.here $ 0.25) *: (there.there.here $ 0.25) *: None +``` + +But what's nice is that this generalizes nicely to categorical composition, so we can do the same with +any category, including the `Kleisli` and `Cokleisli` categories for `Monad`s and `Comonad`s, respectively: + +```haskell +-- some example monadic cascades +mc, nc :: CascadeM IO '[ String, (), String, String, () ] +mc = putStr >=>: + const getLine >=>: + return . map toUpper >=>: + putStrLn >=>: Done +nc = setEnv "foo" >=>: + const (return "foo") >=>: + getEnv >=>: + print . length >=>: Done +``` + +```haskell +-- some example comonadic cascades +wc, vc :: CascadeW ((,) Char) '[ Int, Char, Int, String ] +wc = fst =>=: + fromEnum . snd =>=: + uncurry (flip replicate) =>=: Done +vc = toEnum . snd =>=: + const 5 =>=: + show =>=: Done +``` + +Flipping back to ghci: + +```haskell +λ mc #~ "? " +? i like cheese +I LIKE CHEESE +λ nc #~ "? " +2 +λ wc ~# ('.', 5) +".............................................." +λ vc ~# ('x', 9) +"('x',5)" +λ zigzag mc nc #~ "hi!" +hi!3 +λ zigzag nc mc #~ "hello." +USER +rampion +λ zigzag wc vc ~# ('.', 3) +"....." +λ zigzag vc wc ~# ('a', 9) +"('a',9)" +``` + +`resume` works on both comonads and monads: + +```haskell +λ resumeM nc #~ (there.there.here) "USER" +7 +here () +λ toEither $ resumeW vc # (There . There . Here) ('c',9) +Left ('c',"('c',9)") +``` + +`record` works on comonads, but I've been having some issues getting it to work the way I want on monads (see `Cascade.Product.hs` for more). + +So, instead of continue to wrestle the type system, for now, I just implemented a debugger that uses `Cascade`s, +so in addition running a monadic `Cascade` you can debug it. + +```haskell +-- run the debugger for the mc cascade all the way to the end +rundmc :: IO (DebuggerM IO '[String, String, (), [Char]] () '[]) +rundmc = debugM >>> use "walk this way\n> " >=> step >=> step >=> step $ mc +``` + +Dropping into ghci: + +```haskell +λ d <- rundmc +walk this way +> talk this way +TALK THIS WAY +``` + +We can see the current state of the debugger: + +```haskell +λ d +End { given = "TALK THIS WAY", returned = () } +``` + +the full stack trace + +```haskell +λ printHistory d +End { given = "TALK THIS WAY", returned = () } +Break { given = "talk this way", returned = "TALK THIS WAY" } +Break { given = (), returned = "talk this way" } +Break { given = "walk this way\n> ", returned = () } +Begin +``` + +back up, step forward: + +```haskell +λ back d +Break { given = "talk this way", returned = "TALK THIS WAY" } +λ back it +Break { given = (), returned = "talk this way" } +λ step it +Break { given = "talk this way", returned = "TALK THIS WAY" } +λ step it +TALK THIS WAY +End { given = "TALK THIS WAY", returned = () } +``` + +(Note that when we step forward, the monadic computation reruns) + +We can also use a different input than the default at the current stage: + +```haskell +λ back d +Break { given = "talk this way", returned = "TALK THIS WAY" } +λ d' <- use "(talk this way)" it +(talk this way) +λ printHistory d' +End { given = "(talk this way)", returned = () } +Break { given = "talk this way", returned = "TALK THIS WAY" } +Break { given = (), returned = "talk this way" } +Break { given = "walk this way\n> ", returned = () } +Begin +``` + +And since the debuggers are normal immutable haskell values, we can use both `d` and `d'` without errors. + +--- + +`Cascade`s are still very limited. They're linear, and of a set length. They don't let you hook into functions that call themselves recursively, or functions that have computation paths better represented by trees or lattices. + +But that doesn't mean those are necessarily impossible to model, either. For example, simple recursion is fairly easily captured with only a slight modification to `Cascade` + +```haskell +data CascadeR (ts :: [*]) where + (:>>>) :: x -> y -> CascadeR (y ': zs) -> CascadeR (x ': y ': zs) + Fix :: ((x -> y) -> x -> y) -> CascadeR (y ': zs) -> CascadeR (x ': y ': zs) + Done :: CascadeR '[t] +``` + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain