├── .gitignore ├── LICENSE ├── Notes ├── Architectural Thoughts.md ├── Comonad instance for Nested.md ├── Extensions used and rationale.md ├── Miscellaneous notes.md ├── Notes about ComonadApply and Indexed zippers.md └── The great package reorganization.md ├── Old ├── Checked.hs ├── Composition.hs ├── DatatypeExperiments.hs ├── NumericInstances.hs ├── OldGeneric.hs ├── OldHybridChecked.hs ├── Unchecked.hs ├── UncheckedExamples.hs ├── Z1.hs ├── Z2.hs ├── Z3.hs └── Z4.hs ├── Presentation ├── Presentation.pdf ├── TOC.txt ├── glider.png ├── make-presentation.sh ├── presentation.md ├── rainbow.jpg ├── shark-fin-ocean.jpg ├── waterflow1.png └── waterflow2.png ├── README.md └── src ├── ComonadSheet.cabal ├── Control └── Comonad │ ├── Sheet.hs │ └── Sheet │ ├── Examples.hs │ ├── Indexed.hs │ ├── Manipulate.hs │ ├── Names.hs │ └── Reference.hs ├── LICENSE └── Setup.hs /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | cabal-dev 3 | doc 4 | *.o 5 | *.hi 6 | *.chi 7 | *.chs.h 8 | *.pdf 9 | .virthualenv 10 | cabal.sandbox.config 11 | .cabal-sandbox 12 | .DS_Store 13 | 14 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2018 Kenneth Foner 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Notes/Architectural Thoughts.md: -------------------------------------------------------------------------------- 1 | A separate closed type family in conjunction with an (open, as always) typeclass can simulate a "closed" typeclass, in that it is impossible to define new non-bottom instances once all the possibilities of the type family have been exhausted. This might be slightly untrue in the case of OverlappingInstances... 2 | 3 | The InsertNested and InsertBase typeclasses have the same signature, but mean different things. The user of the library, if they want to add a new thing to be inserted or a new thing to be inserted into, should only have to modify InsertBase. 4 | 5 | While (as noted above) the Insert module can be easily extended to insert new types of list-like things, or to insert *into* new types of tape-like things, Slice is (at present 05-26-2014) not so parameterized; it's specific to Tapes and nested tapes. New instances can be provided for new tape-like types, but it's a fair amount of boilerplate to do so. 6 | 7 | 8 | -------------------------------------------------------------------------------- /Notes/Comonad instance for Nested.md: -------------------------------------------------------------------------------- 1 | This might be an overly-general instance, because it would conflict with another possible (valid) definition for the composition of two comonads, but which requires constraints we can't satisfy with the comonads we're using. Namely, you can also instantiate this instance if you replace @fmap distribute@ with @fmap sequenceA@ (from @Data.Traversable@), and let the resulting instance have the constraints @(Comonad f, Comonad g, Traversable f, Applicative g)@. Since not all of our comonads in this project are applicative, and no infinite structure (e.g. @Tape@) has a good (i.e. not returning bottom in unpredictable ways) definition of @Traversable@, using the @Distributive@ constraint makes much more sense here. 2 | -------------------------------------------------------------------------------- /Notes/Extensions used and rationale.md: -------------------------------------------------------------------------------- 1 | -- To generate this list: 2 | -- for file in *.hs; cat $file | grep LANGUAGE | sed 's/ */ /g'; end | sort | uniq 3 | 4 | -- More expressive kinds 5 | {-# LANGUAGE ConstraintKinds #-} 6 | {-# LANGUAGE DataKinds #-} 7 | {-# LANGUAGE PolyKinds #-} 8 | 9 | -- More expressive typeclasses 10 | {-# LANGUAGE MultiParamTypeClasses #-} 11 | {-# LANGUAGE FlexibleContexts #-} 12 | {-# LANGUAGE FlexibleInstances #-} 13 | 14 | -- More expressive types 15 | {-# LANGUAGE GADTs #-} 16 | {-# LANGUAGE RankNTypes #-} 17 | {-# LANGUAGE TypeFamilies #-} 18 | {-# LANGUAGE ScopedTypeVariables #-} 19 | 20 | -- Syntactic sugar 21 | {-# LANGUAGE LambdaCase #-} 22 | {-# LANGUAGE TypeOperators #-} 23 | 24 | -- Eliminate some trivial boilerplate 25 | {-# LANGUAGE StandaloneDeriving #-} 26 | {-# LANGUAGE DeriveFunctor #-} 27 | 28 | -- Regrettably necessary for some type families and class instances 29 | {-# LANGUAGE UndecidableInstances #-} 30 | -------------------------------------------------------------------------------- /Notes/Miscellaneous notes.md: -------------------------------------------------------------------------------- 1 | quickcheck tests 2 | build out examples 3 | learn/use TH to add dimensions quickly 4 | benchmark versions against each other & benchmark 2 different versions of Comonad-via-Distributive against one another 5 | add more documentation comments to the code 6 | Y modify Peano code to use GADTs to enforce well-formed numbers 7 | Y split out HList-y stuff into a new file 8 | N combine Take/Window into fully generic Slice class 9 | N maybe use existential type wrapper for Abs and Rel to unify before passing into the free applicative 10 | use Cartesian code to implement n-way Cartesian product [aside] 11 | add to/from tuple functions for HList-y stuff and add tuple instances for all the generic functions 12 | Y add Nil to make base cases simpler 13 | N possibly make generic map function for my n-tuples 14 | at, by : tuple -> n-d ref... at is absolute everything, by is relative everything 15 | Y Nats, lists, refs as gadts 16 | Y Homogenize/heterogenize (counted?) 17 | Y Abs needn't be polymorphic 18 | You can't save the asymptotic efficiency of safe evaluate, I think... 19 | 20 | -------------------------------------------------------------------------------- /Notes/Notes about ComonadApply and Indexed zippers.md: -------------------------------------------------------------------------------- 1 | The 'I' functor is a sum monoid on the underlying Enum type's Int representation, as well as trivial Enum and Num based on the underlying type. This is a (somewhat) unprincipled way to make an Indexed zipper a law-obeying member of ComonadApply -- since we already need each element of the index to be an Enum to use duplicate, this doesn't add any extra constraint to the types of indices we'll end up using. Specifically, the problem this solves is that we need indices to behave like a monoid (i.e. we can't just pick one zipper's index) to obey the interchange law that u <@> pure y = pure ($ y) <@> u. 2 | 3 | newtype I a = I a deriving ( Functor , Eq , Ord , Show ) 4 | 5 | type IZ c = Indexed (Identity (I c)) Z 6 | type IZ2 c r = Indexed (I c,I r) Z2 7 | type IZ3 c r l = Indexed (I c,I r,I l) Z3 8 | type IZ4 c r l s = Indexed (I c,I r,I l,I s) Z4 9 | 10 | instance (Monoid a) => Monoid (Identity a) where 11 | mempty = Identity mempty 12 | (Identity a) `mappend` (Identity b) = 13 | Identity (a `mappend` b) 14 | 15 | instance (Enum a) => Enum (Identity a) where 16 | fromEnum (Identity a) = fromEnum a 17 | toEnum a = Identity (toEnum a) 18 | 19 | instance (Enum a) => Enum (I a) where 20 | fromEnum (I a) = fromEnum a 21 | toEnum a = I (toEnum a) 22 | 23 | instance (Enum a) => Monoid (I a) where 24 | mempty = I $ toEnum 0 25 | (I a) `mappend` (I b) = I $ toEnum (fromEnum a + fromEnum b) 26 | 27 | instance (Num a) => Num (I a) where 28 | (I a) + (I b) = I (a + b) 29 | (I a) * (I b) = I (a * b) 30 | abs (I a) = I (abs a) 31 | signum (I a) = I (signum a) 32 | negate (I a) = I (negate a) 33 | fromInteger = I . fromInteger 34 | 35 | Update: I *really* don't like this approach, now that I think about it. Here's how it should work: for each coordinate in the indices, move the zipper with the *lesser* coordinate to the position of the zipper with the *greater* coordinate. We calculate "greater" and "lesser" based on the absolute value of the fromEnum of the index types. We must take the max of each coordinate to satisfy the identity law (pure id <*> v = v), as our definition of pure gives an index at the (fromEnum 0) of each index. Once the zippers are aligned, we can use the now-the-same index as our resultant index, and use the ComonadApply instance of the unindexed zippers to apply them to one another. This satisfies the Applicative laws. 36 | 37 | Update 2: ALL OF THESE PROBLEMS ARE BECAUSE WE ALLOWED PURE!!! If there is no pure (i.e. our Indexed zippers are ComonadApply but not Applicative) then the interchange law doesn't matter, and all we have to satisfy are the ComonadApply laws, which are perfectly happy given an implementation which simply grabs the index of its second argument. No pure means no interchange, means everything works perfectly. It would work equally well to choose the "function" index or the "value" index as the one to preserve; we choose arbitrarily to take the value index. 38 | 39 | Update 3: As noted in e0b8c2a11e25ed83730e0db0fc8e9e3936baf7ed, the previous "arbitrary" choice of keeping the "value" index causes nontermination when evaluating indexed things. This makes total sense. I fixed it. 40 | -------------------------------------------------------------------------------- /Notes/The great package reorganization.md: -------------------------------------------------------------------------------- 1 | The great package reorganization of 2014! 2 | 3 | Package: Tape 4 | Tape -> Data.Stream.Tape 5 | 6 | Package: NestedFunctor 7 | Nested -> Data.Functor.Nested 8 | 9 | Package: IndexedList 10 | IndexedList -> Data.List.Indexed (conversion functions and re-export) 11 | Data.List.Indexed.Counted 12 | Data.List.Indexed.Counted.Tuple (doesn't exist yet) 13 | Data.List.Indexed.Conic (rename TaggedList to ConicList) 14 | 15 | Package: PeanoWitness 16 | Peano -> Data.Numeric.Witness.Peano 17 | 18 | Package: ComonadSheet (note the rename... again) 19 | Evaluate -> Control.Comonad.Sheet (re-exports everything like All) 20 | Indexed -> Control.Comonad.Sheet.Indexed 21 | Names -> Control.Comonad.Sheet.Names 22 | Reference -> Control.Comonad.Sheet.Reference 23 | Manipulate -> Control.Comonad.Sheet.Manipulate 24 | (none) -> Control.Comonad.Sheet.TH (doesn't exist yet; TH for names) 25 | -------------------------------------------------------------------------------- /Old/Checked.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE RankNTypes #-} 4 | {-# LANGUAGE StandaloneDeriving #-} 5 | 6 | module Checked where 7 | 8 | import Control.Applicative 9 | import Control.Applicative.Free 10 | import Data.Traversable ( Traversable , traverse ) 11 | 12 | -- | A 'CellRef' is a reference of type r from a container of things of type a, which results in 13 | -- something of type b. When dereferenced, a plain 'CellRef' will always give a result of type a, 14 | -- but used in a free applicative functor, b varies over the result type of the expression. 15 | data CellRef r f a b where 16 | StaticRef :: r -> CellRef r f a a 17 | DynamicRef :: (f a -> b) -> CellRef r f a b 18 | 19 | -- | A CellExpr is the free applicative functor over 'CellRefs'. A CellExpr is an expression using 20 | -- references of type r to a container of things of type a, whose result is something of type b. 21 | type CellExpr r f a = Ap (CellRef r f a) 22 | 23 | -- | Returns the list of all references in a CellExpr. 24 | references :: CellExpr r f a b -> Maybe [r] 25 | references (Pure _) = Just [] 26 | references (Ap (StaticRef r) x) = (r :) <$> references x 27 | references (Ap (DynamicRef _) _) = Nothing 28 | 29 | -- | An 'Extract' is a synonym for a function which knows how to take something out of a structure 30 | -- which may contain things of any type. 31 | type Extract f = forall x. f x -> x 32 | 33 | -- | Given an appropriate method of dereferencing and a CellExpr, returns the function from a structure 34 | -- to a value which is represented by a CellExpr. 35 | runCell :: (r -> Extract f) -> CellExpr r f a b -> f a -> b 36 | runCell e = runAp $ \case StaticRef r -> e r 37 | DynamicRef f -> f 38 | 39 | -- | Constructs a CellExpr which evaluates to whatever is at index r. 40 | cell :: r -> CellExpr r f a a 41 | cell = liftAp . StaticRef 42 | 43 | -- | Lift a function on a structure to a CellExpr. 44 | liftC :: (f a -> b) -> CellExpr r f a b 45 | liftC = liftAp . DynamicRef 46 | 47 | -- | Constructs a CellExpr which evaluates to a Traversable of the referents of the references given. 48 | cells :: Traversable t => t r -> CellExpr r f a (t a) 49 | cells = traverse cell 50 | -------------------------------------------------------------------------------- /Old/Composition.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE TypeFamilies #-} 4 | {-# LANGUAGE MultiParamTypeClasses #-} 5 | {-# LANGUAGE UndecidableInstances #-} 6 | {-# LANGUAGE OverlappingInstances #-} 7 | 8 | module Composition 9 | ( ComposeCount(..) 10 | , CountCompose(..) 11 | , NthCompose(..) 12 | , ComposeN(..) 13 | , composedly 14 | , asComposedAs 15 | , module Data.Functor.Compose 16 | ) where 17 | 18 | import Data.Functor.Compose 19 | 20 | import Peano 21 | 22 | -- | Apply a function to the inside of a @Compose@. 23 | -- 24 | -- @composedly f = Compose . f . getCompose@ 25 | composedly :: (f (g a) -> f' (g' a')) -> Compose f g a -> Compose f' g' a' 26 | composedly f = Compose . f . getCompose 27 | 28 | type family ComposeCount f where 29 | ComposeCount (Compose f g a) = S (ComposeCount (f (g a))) 30 | ComposeCount x = Zero 31 | 32 | class CountCompose f where 33 | countCompose :: f -> ComposeCount f 34 | instance (CountCompose (f (g a))) => CountCompose (Compose f g a) where 35 | countCompose (Compose x) = S (countCompose x) 36 | instance (ComposeCount f ~ Zero) => CountCompose f where 37 | countCompose _ = Zero 38 | 39 | type family NthCompose n a where 40 | NthCompose Zero a = a 41 | NthCompose (S n) (f (g a)) = NthComposeIter n a (Compose f g) 42 | 43 | type family NthComposeIter n a f where 44 | NthComposeIter Zero a f = f a 45 | NthComposeIter (S n) (g a) f = NthComposeIter n a (Compose f g) 46 | 47 | class ComposeN n f 48 | where composeN :: n -> f -> NthCompose n f 49 | instance (NthCompose Zero f ~ f) => ComposeN Zero f 50 | where composeN Zero = id 51 | instance (ComposeN n f, NthCompose n f ~ g (h a), NthCompose (S n) f ~ Compose g h a) => ComposeN (S n) f 52 | where composeN (S n) = Compose . composeN n 53 | 54 | asComposedAs :: (CountCompose g, ComposeN (ComposeCount g) f) => f -> g -> NthCompose (ComposeCount g) f 55 | f `asComposedAs` g = composeN (countCompose g) f 56 | -------------------------------------------------------------------------------- /Old/DatatypeExperiments.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs, DataKinds, FlexibleContexts, TypeFamilies #-} 2 | 3 | module DatatypeExperiments where 4 | 5 | import Prelude hiding (Left,Right) 6 | import Control.Applicative 7 | 8 | data ExtentH = InfL | InfLR | InfR 9 | data ExtentV = InfU | InfUD | InfD 10 | 11 | infixr 5 :. 12 | 13 | data NonEmptyList a = F a | a :. NonEmptyList a deriving Show 14 | 15 | infixr 5 :<<: 16 | infixr 5 :>>: 17 | 18 | data Row (e :: ExtentH) c r a b where 19 | (:>>:) :: [CellExpr c r a b] -> NonEmptyList (CellExpr c r a b) -> Row InfR c r a b 20 | (:<<:) :: NonEmptyList (CellExpr c r a b) -> Row InfR c r a b -> Row InfLR c r a b 21 | 22 | infixr 5 :\/: 23 | infixr 5 :/\: 24 | 25 | data Col (e :: ExtentV) c r a b where 26 | (:\/:) :: [Row InfLR c r a b] -> NonEmptyList (Row InfLR c r a b) -> Col InfD c r a b 27 | (:/\:) :: NonEmptyList (Row InfLR c r a b) -> Col InfD c r a b -> Col InfUD c r a b 28 | 29 | data CellExpr c r a b = Cell (CellRef c r -> CellRef c r) 30 | | App (CellExpr c r a (a -> b)) (CellExpr c r a a) 31 | | Con b 32 | 33 | data CellRef c r = This 34 | | Up (CellRef c r) 35 | | Down (CellRef c r) 36 | | Left (CellRef c r) 37 | | Right (CellRef c r) 38 | | AboveBy Int (CellRef c r) 39 | | BelowBy Int (CellRef c r) 40 | | LeftBy Int (CellRef c r) 41 | | RightBy Int (CellRef c r) 42 | | AtRow r (CellRef c r) 43 | | AtCol c (CellRef c r) 44 | | At (c,r) (CellRef c r) 45 | deriving Show 46 | 47 | evalCellExpr :: CellExpr c r a b -> a -> b 48 | evalCellExpr (Con a) = pure a 49 | evalCellExpr (App a z) = (evalCellExpr a) <*> (evalCellExpr z) 50 | --evalCellExpr (Cell r) = cell up 51 | 52 | instance Functor (CellExpr c r a) where 53 | fmap f (Con b) = Con (f b) 54 | fmap f (App a z) = App (fmap (f .) a) z 55 | 56 | infixl 4 <&> 57 | 58 | (<&>) :: CellExpr c r a (a -> b) -> CellExpr c r a a -> CellExpr c r a b 59 | (<&>) = App 60 | 61 | --data FunList a b = Fun b | Arg a (FunList a (a -> b)) 62 | 63 | --getB :: FunList a b -> b 64 | --getB (Fun b) = b 65 | --getB (Arg a z) = getB z a 66 | 67 | --getAs :: FunList a b -> [a] 68 | --getAs (Fun _) = [] 69 | --getAs (Arg a z) = a : getAs z 70 | 71 | -- 72 | 73 | x = F (F (Cell Down) :<<: [] :>>: F (Cell Right)) 74 | :/\: 75 | [] 76 | :\/: 77 | F (F (Cell Right) :<<: [] :>>: F (Cell Down)) 78 | -------------------------------------------------------------------------------- /Old/NumericInstances.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverlappingInstances #-} 4 | {-# LANGUAGE UndecidableInstances #-} 5 | 6 | module NumericInstances where 7 | 8 | import Control.Applicative 9 | 10 | instance (Applicative f, Num a) => Num (f a) where 11 | (+) = liftA2 (+) 12 | (*) = liftA2 (*) 13 | (-) = liftA2 (-) 14 | abs = fmap abs 15 | signum = fmap signum 16 | fromInteger = pure . fromInteger 17 | 18 | instance (Ord (f a), Applicative f, Real a) => Real (f a) where 19 | toRational = error "toRational: can't go from arbitrary functor to rational" 20 | 21 | instance (Fractional a, Applicative f) => Fractional (f a) where 22 | recip = fmap recip 23 | fromRational = pure . fromRational 24 | 25 | instance (Enum (f a), Real (f a), Applicative f, Integral a) => Integral (f a) where 26 | quot = liftA2 quot 27 | rem = liftA2 rem 28 | div = liftA2 div 29 | mod = liftA2 mod 30 | x `quotRem` y = (x `quot` y, x `rem` y) 31 | x `divMod` y = (x `div` y, x `mod` y) 32 | toInteger = error "toInteger: can't go from arbitrary functor to integer" 33 | -------------------------------------------------------------------------------- /Old/OldGeneric.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TupleSections, MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies #-} 2 | 3 | module Generic 4 | ( module Control.Applicative, module Control.Comonad 5 | 6 | , AnyZipper(..) , Ref(..) , RefOf(..) , AnyRef(..) 7 | 8 | , goto , modify 9 | , genericZipBy , genericZipTo , genericDeref 10 | 11 | , Zipper1(..) , Zipper2(..) , Zipper3(..) , Zipper4(..) 12 | , Ref1(..) , Ref2(..) , Ref3(..) , Ref4(..) 13 | 14 | , right , left , below , above , outward , inward , kata , ana 15 | ) where 16 | 17 | import Control.Applicative 18 | import Control.Comonad 19 | 20 | data Ref x = Abs x | Rel Int deriving (Show, Eq, Ord) 21 | 22 | class RefOf ref zipper list | zipper -> ref list where 23 | go :: ref -> zipper -> zipper 24 | slice :: ref -> ref -> zipper -> list 25 | insert :: list -> zipper -> zipper 26 | 27 | class AnyZipper z i a | z -> i a where 28 | index :: z -> i 29 | view :: z -> a 30 | write :: a -> z -> z 31 | reindex :: i -> z -> z 32 | 33 | modify :: AnyZipper z i a => (a -> a) -> z -> z 34 | modify f = write <$> f . view <*> id 35 | 36 | class Zipper1 z c | z -> c where 37 | zipL :: z -> z 38 | zipR :: z -> z 39 | col :: z -> c 40 | 41 | class Zipper2 z r | z -> r where 42 | zipU :: z -> z 43 | zipD :: z -> z 44 | row :: z -> r 45 | 46 | class Zipper3 z l | z -> l where 47 | zipI :: z -> z 48 | zipO :: z -> z 49 | level :: z -> l 50 | 51 | class Zipper4 z s | z -> s where 52 | zipA :: z -> z 53 | zipK :: z -> z 54 | space :: z -> s 55 | 56 | infixl 6 & 57 | 58 | class AnyRef ref i | ref -> i where 59 | at :: i -> ref 60 | here :: ref 61 | (&) :: ref -> ref -> ref 62 | 63 | goto :: (RefOf ref zipper list, AnyRef ref i) => i -> zipper -> zipper 64 | goto = go . at 65 | 66 | instance Enum col => AnyRef (Ref col) col where 67 | here = Rel 0 68 | at = Abs 69 | Abs x & Rel y = Abs $ toEnum (fromEnum x + y) 70 | Rel x & Abs y = Abs $ toEnum (x + fromEnum y) 71 | Rel x & Rel y = Rel (x + y) 72 | Abs _ & Abs y = Abs y 73 | 74 | instance (Enum col, Enum row) => AnyRef (Ref col,Ref row) (col,row) where 75 | here = (here,here) 76 | at (c,r) = (at c,at r) 77 | (c,r) & (c',r') = (c & c',r & r') 78 | 79 | instance (Enum col, Enum row, Enum lev) => AnyRef (Ref col, Ref row,Ref lev) (col,row,lev) where 80 | here = (here,here,here) 81 | at (c,r,l) = (at c,at r,at l) 82 | (c,r,l) & (c',r',l') = (c & c',r & r',l & l') 83 | 84 | instance (Enum col, Enum row, Enum lev, Enum spc) => AnyRef (Ref col, Ref row,Ref lev,Ref spc) (col,row,lev,spc) where 85 | here = (here,here,here,here) 86 | at (c,r,l,s) = (at c,at r,at l,at s) 87 | (c,r,l,s) & (c',r',l',s') = (c & c',r & r',l & l',s & s') 88 | 89 | class Ref1 ref col | ref -> col where 90 | rightBy :: Int -> ref 91 | rightBy = leftBy . negate 92 | leftBy :: Int -> ref 93 | leftBy = rightBy . negate 94 | atCol :: col -> ref 95 | 96 | class Ref2 ref row | ref -> row where 97 | belowBy :: Int -> ref 98 | belowBy = aboveBy . negate 99 | aboveBy :: Int -> ref 100 | aboveBy = belowBy . negate 101 | atRow :: row -> ref 102 | 103 | class Ref3 ref lev | ref -> lev where 104 | inwardBy :: Int -> ref 105 | inwardBy = outwardBy . negate 106 | outwardBy :: Int -> ref 107 | outwardBy = inwardBy . negate 108 | atLevel :: lev -> ref 109 | 110 | class Ref4 ref lev | ref -> lev where 111 | anaBy :: Int -> ref 112 | anaBy = kataBy . negate 113 | kataBy :: Int -> ref 114 | kataBy = anaBy . negate 115 | atSpace :: lev -> ref 116 | 117 | above, below :: Ref2 ref row => ref 118 | above = aboveBy 1 119 | below = belowBy 1 120 | 121 | right, left :: Ref1 ref col => ref 122 | right = rightBy 1 123 | left = leftBy 1 124 | 125 | inward, outward :: Ref3 ref lev => ref 126 | inward = inwardBy 1 127 | outward = outwardBy 1 128 | 129 | ana, kata :: Ref4 ref spc => ref 130 | ana = anaBy 1 131 | kata = kataBy 1 132 | 133 | instance Enum col => Ref1 (Ref col) col where 134 | rightBy = Rel 135 | atCol = Abs 136 | 137 | instance (Enum row, Enum col) => Ref1 (Ref col,Ref row) col where 138 | rightBy = (,here) . Rel 139 | atCol = (,here) . Abs 140 | 141 | instance (Enum row, Enum col) => Ref2 (Ref col,Ref row) row where 142 | belowBy = (here,) . Rel 143 | atRow = (here,) . Abs 144 | 145 | instance (Enum row, Enum col, Enum lev) => Ref1 (Ref col,Ref row,Ref lev) col where 146 | rightBy = (,here,here) . Rel 147 | atCol = (,here,here) . Abs 148 | 149 | instance (Enum row, Enum col, Enum lev) => Ref2 (Ref col,Ref row,Ref lev) row where 150 | belowBy = (here,,here) . Rel 151 | atRow = (here,,here) . Abs 152 | 153 | instance (Enum row, Enum col, Enum lev) => Ref3 (Ref col,Ref row,Ref lev) lev where 154 | outwardBy = (here,here,) . Rel 155 | atLevel = (here,here,) . Abs 156 | 157 | instance (Enum row, Enum col, Enum lev, Enum spc) => Ref1 (Ref col,Ref row,Ref lev,Ref spc) col where 158 | rightBy = (,here,here,here) . Rel 159 | atCol = (,here,here,here) . Abs 160 | 161 | instance (Enum row, Enum col, Enum lev, Enum spc) => Ref2 (Ref col,Ref row,Ref lev,Ref spc) row where 162 | belowBy = (here,,here,here) . Rel 163 | atRow = (here,,here,here) . Abs 164 | 165 | instance (Enum row, Enum col, Enum lev, Enum spc) => Ref3 (Ref col,Ref row,Ref lev,Ref spc) lev where 166 | outwardBy = (here,here,,here) . Rel 167 | atLevel = (here,here,,here) . Abs 168 | 169 | instance (Enum row, Enum col, Enum lev, Enum spc) => Ref4 (Ref col,Ref row,Ref lev,Ref spc) spc where 170 | kataBy = (here,here,here,) . Rel 171 | atSpace = (here,here,here,) . Abs 172 | 173 | genericZipBy :: (z -> z) -> (z -> z) -> Int -> z -> z 174 | genericZipBy zl zr i | i < 0 = genericZipBy zl zr (succ i) . zl 175 | genericZipBy zl zr i | i > 0 = genericZipBy zl zr (pred i) . zr 176 | genericZipBy zl zr i | otherwise = id 177 | 178 | genericZipTo :: (Ord i) => (z -> z) -> (z -> z) -> (z -> i) -> i -> z -> z 179 | genericZipTo zl zr idx i z | i < idx z = genericZipTo zl zr idx i . zl $ z 180 | genericZipTo zl zr idx i z | i > idx z = genericZipTo zl zr idx i . zr $ z 181 | genericZipTo zl zr idx i z | otherwise = z 182 | 183 | genericDeref :: (Ord i) => (z -> z) -> (z -> z) -> (z -> i) -> Ref i -> z -> z 184 | genericDeref zl zr idx ref = 185 | case ref of 186 | Rel i -> relative i 187 | Abs x -> absolute x 188 | where relative = genericZipBy zl zr 189 | absolute = genericZipTo zl zr idx 190 | -------------------------------------------------------------------------------- /Old/OldHybridChecked.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TupleSections #-} 2 | 3 | module OldHybridChecked 4 | ( CellExpr(DynamicCell) 5 | , cell , cells , dcell , dcells 6 | ) where 7 | 8 | import Generic 9 | import qualified Unchecked as U 10 | import Z1 11 | import Z2 12 | import Z3 13 | import Z4 14 | 15 | import Data.Monoid 16 | import Data.Set (Set) 17 | import qualified Data.Set as Set 18 | 19 | data CellExpr z ref a = StaticCell { getRefs :: Set ref, appSCell :: z -> a } 20 | | DynamicCell { appDCell :: z -> a } 21 | 22 | appCell :: CellExpr z ref a -> z -> a 23 | appCell (StaticCell _ f) = f 24 | appCell (DynamicCell f) = f 25 | 26 | instance (Show ref) => Show (CellExpr z ref a) where 27 | show (StaticCell refs _) = "StaticCell (" ++ show refs ++ ") _" 28 | show (DynamicCell _) = "DynamicCell _" 29 | 30 | instance Functor (CellExpr z ref) where 31 | fmap f (StaticCell refs a) = StaticCell refs (f . a) 32 | fmap f (DynamicCell a) = DynamicCell (f . a) 33 | 34 | instance (Ord ref) => Applicative (CellExpr z ref) where 35 | pure = StaticCell Set.empty . const 36 | StaticCell r a <*> StaticCell s b = StaticCell (r <> s) (a <*> b) 37 | StaticCell _ a <*> DynamicCell b = DynamicCell (a <*> b) 38 | DynamicCell a <*> StaticCell _ b = DynamicCell (a <*> b) 39 | DynamicCell a <*> DynamicCell b = DynamicCell (a <*> b) 40 | 41 | indexDeref :: (Ord x, Enum x) => Ref x -> x -> x 42 | indexDeref = genericDeref pred succ id 43 | 44 | cell :: (Ord ref, RefOf ref z list, AnyZipper z i a) => ref -> CellExpr z ref a 45 | cell = StaticCell <$> Set.singleton <*> U.cell 46 | 47 | cells :: (Ord ref, RefOf ref z list, AnyZipper z i a) => [ref] -> CellExpr z ref [a] 48 | cells = StaticCell <$> Set.fromList <*> U.cells 49 | 50 | dcell :: (z -> a) -> CellExpr z ref a 51 | dcell = DynamicCell 52 | 53 | dcells :: (z -> [a]) -> CellExpr z ref [a] 54 | dcells = DynamicCell 55 | -------------------------------------------------------------------------------- /Old/Unchecked.hs: -------------------------------------------------------------------------------- 1 | module Unchecked where 2 | 3 | import Generic 4 | 5 | import Data.Function 6 | 7 | evaluate :: ComonadApply w => w (w a -> a) -> w a 8 | evaluate fs = fix $ (fs <@>) . duplicate 9 | --evaluate = extend wfix -- more elegant, but breaks sharing, resulting in exponential performance penalty 10 | 11 | cell :: (RefOf r z l, AnyZipper z i a) => r -> z -> a 12 | cell = (view .) . go 13 | 14 | cells :: (RefOf r z l, AnyZipper z i a) => [r] -> z -> [a] 15 | cells refs zipper = map (`cell` zipper) refs 16 | 17 | sheet :: (Applicative z, AnyZipper (z a) i a, RefOf ref (z a) list) => i -> a -> list -> z a 18 | sheet origin background list = insert list . reindex origin $ pure background 19 | -------------------------------------------------------------------------------- /Old/UncheckedExamples.hs: -------------------------------------------------------------------------------- 1 | module UncheckedExamples where 2 | 3 | import Generic 4 | import Z1 5 | import Z2 6 | import Z3 7 | import Z4 8 | import Unchecked 9 | import NumericInstances 10 | 11 | import Control.Arrow (first, second) 12 | 13 | -- Some example zippers for testing... 14 | 15 | fibLike :: Z3 Int Int Int Integer 16 | fibLike = evaluate $ sheet (0,0,0) 0 $ 17 | fibSheetFrom 1 1 : repeat (fibSheetFrom (cell inward + 1) (cell inward)) 18 | where fibSheetFrom a b = ([a, b] ++ fibRow) : repeat 19 | ([cell above, 1 + cell above] ++ fibRow) 20 | fibRow = repeat $ cell (leftBy 1) + cell (leftBy 2) 21 | 22 | pascal :: Z2 Int Int Integer 23 | pascal = evaluate $ sheet (0,0) 0 $ 24 | repeat 1 : repeat (1 : pascalRow) 25 | where pascalRow = repeat $ cell above + cell left 26 | 27 | pascalLists :: [[Integer]] 28 | pascalLists = map pascalList [0..] 29 | where 30 | pascalList n = 31 | map view . 32 | takeWhile ((>= 0) . row) . 33 | iterate (go $ above & right) . 34 | goto (0,n) $ pascal 35 | 36 | numberLine :: Z1 Integer Integer 37 | numberLine = zipper 0 (map negate [1..]) 0 [1..] 38 | 39 | numberLine2D :: Z2 Integer Integer Integer 40 | numberLine2D = Z2 $ zipper 0 (tail (iterate (fmap pred) numberLine)) 41 | numberLine 42 | (tail (iterate (fmap succ) numberLine)) 43 | 44 | cartesian :: Z2 Integer Integer (Integer,Integer) 45 | cartesian = Z2 $ zipper 0 (tail (iterate (fmap (second pred)) (fmap (,0) numberLine))) 46 | (fmap (,0) numberLine) 47 | (tail (iterate (fmap (second succ)) (fmap (,0) numberLine))) 48 | 49 | cartesian' :: Z2 Integer Integer (Integer,Integer) 50 | cartesian' = evaluate $ Z2 $ zipper 0 51 | [zipperOf 0 (second pred <$> cell below)] 52 | (zipper 0 [first pred <$> cell right] (const (0,0)) [first succ <$> cell left]) 53 | [zipperOf 0 (second succ <$> cell above)] 54 | 55 | data ConwayCell = X | O deriving (Eq,Show) 56 | type ConwayUniverse = Z3 Int Int Int ConwayCell 57 | 58 | conway :: [[ConwayCell]] -> ConwayUniverse 59 | conway seed = evaluate $ insert [map (map const) seed] blankConway 60 | where blankConway = wrapZ3 (insert . repeat $ pure rule) $ pure (const X) 61 | where rule z = case neighbors z of 62 | 2 -> cell inward z 63 | 3 -> O 64 | _ -> X 65 | neighbors = count (== O) <$> cells bordering 66 | count = (length .) . filter 67 | bordering = map (inward &) . filter (/= here) $ 68 | (&) <$> [left,here,right] <*> [above,here,below] 69 | 70 | printConway :: (Int,Int) -> (Int,Int) -> Int -> ConwayUniverse -> IO () 71 | printConway (c,r) (c',r') generations universe = do 72 | separator 73 | mapM_ ((>> separator) . printGen) $ 74 | slice (at (c,r,0)) (at (c',r',generations)) universe 75 | where 76 | separator = putStrLn $ replicate (1 + abs $ c - c') '-' 77 | printGen = mapM_ $ putStrLn . map showCell 78 | showCell X = ' ' 79 | showCell O = '*' 80 | 81 | lonelyGlider :: ConwayUniverse 82 | lonelyGlider = conway [[X,X,O], 83 | [O,X,O], 84 | [X,O,O]] 85 | 86 | lonelySpaceship :: ConwayUniverse 87 | lonelySpaceship = conway [[X,X,X,X,X], 88 | [X,O,O,O,O], 89 | [O,X,X,X,O], 90 | [X,X,X,X,O], 91 | [O,X,X,O,X], 92 | [X,X,X,X,X]] 93 | -------------------------------------------------------------------------------- /Old/Z1.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} 2 | 3 | module Z1 4 | ( module Generic , Z1 5 | , zipper , zipperOf , zipIterate 6 | , switch 7 | , insertL , insertR , deleteL , deleteR 8 | , insertListR , insertListL 9 | ) where 10 | 11 | import Generic 12 | 13 | data Z1 i a = Z1 !i [a] a [a] 14 | 15 | instance Functor (Z1 i) where 16 | fmap f = Z1 <$> index 17 | <*> fmap f . viewL 18 | <*> f . view 19 | <*> fmap f . viewR 20 | 21 | instance (Enum i, Ord i) => Applicative (Z1 i) where 22 | fs <*> xs = 23 | Z1 (index fs) 24 | (zipWith ($) (viewL fs) (viewL xs)) 25 | (view fs $ view xs) 26 | (zipWith ($) (viewR fs) (viewR xs)) 27 | -- In the case of bounded types, the (toEnum 0) might be a problem; use zipperOf to specify a custom starting index for the zipper 28 | pure = zipperOf (toEnum 0) 29 | 30 | instance (Enum i, Ord i) => ComonadApply (Z1 i) where 31 | (<@>) = (<*>) 32 | 33 | instance (Ord i, Enum i) => Comonad (Z1 i) where 34 | extract = view 35 | duplicate = widthWise 36 | where widthWise = zipIterate zipL zipR <$> col <*> id 37 | 38 | instance AnyZipper (Z1 i a) i a where 39 | index (Z1 i _ _ _) = i 40 | view (Z1 _ _ c _) = c 41 | write c (Z1 i l _ r) = Z1 i l c r 42 | reindex i (Z1 _ l c r) = Z1 i l c r 43 | 44 | instance (Enum i, Ord i) => Zipper1 (Z1 i a) i where 45 | zipL (Z1 i (l : ls) cursor rs) = 46 | Z1 (pred i) ls l (cursor : rs) 47 | zipL _ = error "zipL of non-infinite zipper; the impossible has occurred" 48 | 49 | zipR (Z1 i ls cursor (r : rs)) = 50 | Z1 (succ i) (cursor : ls) r rs 51 | zipR _ = error "zipR of non-infinite zipper; the impossible has occurred" 52 | 53 | col = index 54 | 55 | instance (Ord c, Enum c) => RefOf (Ref c) (Z1 c a) [a] where 56 | go = genericDeref zipL zipR index 57 | insert = insertListR 58 | slice ref1 ref2 z = 59 | if dist >= 0 60 | then take (dist + 1) . viewR $ go left loc1 61 | else take ((- dist) + 1) . viewL $ go right loc1 62 | where loc1 = go ref1 z 63 | loc2 = go ref2 z 64 | dist = fromEnum (index loc2) - fromEnum (index loc1) 65 | 66 | zipper :: i -> [a] -> a -> [a] -> Z1 i a 67 | zipper i ls cursor rs = Z1 i (cycle ls) cursor (cycle rs) 68 | 69 | zipperOf :: i -> a -> Z1 i a 70 | zipperOf = zipIterate id id 71 | 72 | zipIterate :: (a -> a) -> (a -> a) -> i -> a -> Z1 i a 73 | zipIterate prev next i current = 74 | Z1 i <$> (tail . iterate prev) 75 | <*> id 76 | <*> (tail . iterate next) $ current 77 | 78 | viewL :: Z1 i a -> [a] 79 | viewL (Z1 _ ls _ _) = ls 80 | 81 | viewR :: Z1 i a -> [a] 82 | viewR (Z1 _ _ _ rs) = rs 83 | 84 | switch :: Z1 i a -> Z1 i a 85 | switch (Z1 i ls cursor rs) = Z1 i rs cursor ls 86 | 87 | insertR, insertL :: a -> Z1 i a -> Z1 i a 88 | insertR x (Z1 i ls cursor rs) = Z1 i ls x (cursor : rs) 89 | insertL x (Z1 i ls cursor rs) = Z1 i (cursor : ls) x rs 90 | 91 | insertListR, insertListL :: [a] -> Z1 i a -> Z1 i a 92 | 93 | insertListR [] z = z 94 | insertListR list (Z1 i ls cursor rs) = 95 | Z1 i ls (head list) (tail list ++ cursor : rs) 96 | 97 | insertListL [] z = z 98 | insertListL list (Z1 i ls cursor rs) = 99 | Z1 i (tail list ++ cursor : ls) (head list) rs 100 | 101 | deleteL, deleteR :: Z1 i a -> Z1 i a 102 | deleteL (Z1 i (l : ls) cursor rs) = Z1 i ls l rs 103 | deleteL _ = error "deleteL: empty zipper" 104 | deleteR (Z1 i ls cursor (r : rs)) = Z1 i ls r rs 105 | deleteR _ = error "deleteR: empty zipper" 106 | -------------------------------------------------------------------------------- /Old/Z2.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} 2 | 3 | module Z2 4 | ( module Generic , Z2(..) , wrapZ2 5 | ) where 6 | 7 | import Generic 8 | import Z1 9 | 10 | newtype Z2 c r a = Z2 { fromZ2 :: Z1 r (Z1 c a) } 11 | 12 | wrapZ2 :: (Z1 r (Z1 c a) -> Z1 r' (Z1 c' a')) -> Z2 c r a -> Z2 c' r' a' 13 | wrapZ2 = (Z2 .) . (. fromZ2) 14 | 15 | instance Functor (Z2 c r) where 16 | fmap = wrapZ2 . fmap . fmap 17 | 18 | instance (Ord c, Ord r, Enum c, Enum r) => Applicative (Z2 c r) where 19 | fs <*> xs = Z2 $ fmap (<*>) (fromZ2 fs) <*> (fromZ2 xs) 20 | pure = Z2 . pure . pure 21 | 22 | instance (Ord c, Ord r, Enum c, Enum r) => ComonadApply (Z2 c r) where 23 | (<@>) = (<*>) 24 | 25 | instance (Ord c, Ord r, Enum c, Enum r) => Comonad (Z2 c r) where 26 | extract = view 27 | duplicate = Z2 . widthWise . heightWise 28 | where widthWise = fmap $ zipIterate zipL zipR <$> col <*> id 29 | heightWise = zipIterate zipU zipD <$> row <*> id 30 | 31 | instance (Ord c, Ord r, Enum c, Enum r) => Zipper1 (Z2 c r a) c where 32 | zipL = wrapZ2 $ fmap zipL 33 | zipR = wrapZ2 $ fmap zipR 34 | col = index . view . fromZ2 35 | 36 | instance (Ord c, Ord r, Enum c, Enum r) => Zipper2 (Z2 c r a) r where 37 | zipU = wrapZ2 zipL 38 | zipD = wrapZ2 zipR 39 | row = index . fromZ2 40 | 41 | instance (Ord c, Enum c, Ord r, Enum r) => RefOf (Ref c,Ref r) (Z2 c r a) [[a]] where 42 | slice (c,r) (c',r') = slice r r' . fmap (slice c c') . fromZ2 43 | insert list z = Z2 $ insert <$> (insert list (pure [])) <*> fromZ2 z 44 | go (colRef,rowRef) = horizontal . vertical 45 | where 46 | horizontal = genericDeref zipL zipR col colRef 47 | vertical = genericDeref zipU zipD row rowRef 48 | 49 | instance (Ord c, Enum c, Ord r, Enum r) => AnyZipper (Z2 c r a) (c,r) a where 50 | index = (,) <$> col <*> row 51 | view = view . view . fromZ2 52 | write = wrapZ2 . modify . write 53 | reindex (c,r) = wrapZ2 (fmap (reindex c) . reindex r) 54 | 55 | modifyCell :: (Ord c, Enum c, Ord r, Enum r) => (a -> a) -> Z2 c r a -> Z2 c r a 56 | modifyCell f = write <$> f . view <*> id 57 | 58 | modifyRow :: (Z1 c a -> Z1 c a) -> Z2 c r a -> Z2 c r a 59 | modifyRow = wrapZ2 . modify 60 | 61 | modifyCol :: (Enum r, Ord r) => (Z1 r a -> Z1 r a) -> Z2 c r a -> Z2 c r a 62 | modifyCol f = writeCol <$> f . fmap view . fromZ2 <*> id 63 | 64 | writeRow :: Z1 c a -> Z2 c r a -> Z2 c r a 65 | writeRow = wrapZ2 . write 66 | 67 | writeCol :: (Ord r, Enum r) => Z1 r a -> Z2 c r a -> Z2 c r a 68 | writeCol c plane = Z2 $ write <$> c <*> fromZ2 plane 69 | 70 | insertRowU, insertRowD :: Z1 c a -> Z2 c r a -> Z2 c r a 71 | insertRowU = wrapZ2 . insertL 72 | insertRowD = wrapZ2 . insertR 73 | 74 | deleteRowD, deleteRowU :: Z2 c r a -> Z2 c r a 75 | deleteRowD = wrapZ2 deleteR 76 | deleteRowU = wrapZ2 deleteL 77 | 78 | insertColL, insertColR :: (Ord r, Enum r) => Z1 r a -> Z2 c r a -> Z2 c r a 79 | insertColL c plane = Z2 $ insertL <$> c <*> fromZ2 plane 80 | insertColR c plane = Z2 $ insertR <$> c <*> fromZ2 plane 81 | 82 | deleteColL, deleteColR :: (Ord r, Enum r) => Z2 c r a -> Z2 c r a 83 | deleteColL = wrapZ2 $ fmap deleteL 84 | deleteColR = wrapZ2 $ fmap deleteR 85 | 86 | insertCellD, insertCellU :: (Ord r, Enum r) => a -> Z2 c r a -> Z2 c r a 87 | insertCellD = modifyCol . insertR 88 | insertCellU = modifyCol . insertL 89 | 90 | insertCellR, insertCellL :: (Ord c, Enum c) => a -> Z2 c r a -> Z2 c r a 91 | insertCellR = modifyRow . insertR 92 | insertCellL = modifyRow . insertL 93 | 94 | deleteCellD, deleteCellU :: (Ord r, Enum r) => Z2 c r a -> Z2 c r a 95 | deleteCellD = modifyCol deleteR 96 | deleteCellU = modifyCol deleteL 97 | 98 | deleteCellR, deleteCellL :: (Ord c, Enum c) => Z2 c r a -> Z2 c r a 99 | deleteCellR = modifyRow deleteR 100 | deleteCellL = modifyRow deleteL 101 | 102 | --TODO... 103 | --insertCellsR, insertCellsL, insertCellsU, insertCellsD 104 | --insertColsR, insertColsL, insertRowsU, insertRowsD 105 | -------------------------------------------------------------------------------- /Old/Z3.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} 2 | 3 | module Z3 4 | ( module Generic , Z3(..) , wrapZ3 5 | ) where 6 | 7 | import Generic 8 | import Z1 9 | import Z2 10 | 11 | newtype Z3 c r l a = Z3 { fromZ3 :: Z1 l (Z2 c r a) } 12 | 13 | wrapZ3 :: (Z1 l (Z2 c r a) -> Z1 l' (Z2 c' r' a')) -> Z3 c r l a -> Z3 c' r' l' a' 14 | wrapZ3 = (Z3 .) . (. fromZ3) 15 | 16 | layersFromZ3 :: Z3 c r l a -> Z1 l (Z1 r (Z1 c a)) 17 | layersFromZ3 = fmap fromZ2 . fromZ3 18 | 19 | layersToZ3 :: Z1 l (Z1 r (Z1 c a)) -> Z3 c r l a 20 | layersToZ3 = Z3 . fmap Z2 21 | 22 | instance Functor (Z3 c r l) where 23 | fmap = wrapZ3 . fmap . fmap 24 | 25 | instance (Ord c, Ord r, Ord l, Enum c, Enum r, Enum l) => Applicative (Z3 c r l) where 26 | fs <*> xs = Z3 $ fmap (<*>) (fromZ3 fs) <*> (fromZ3 xs) 27 | pure = Z3 . pure . pure 28 | 29 | instance (Ord c, Ord r, Ord l, Enum c, Enum r, Enum l) => ComonadApply (Z3 c r l) where 30 | (<@>) = (<*>) 31 | 32 | instance (Ord c, Ord r, Ord l, Enum c, Enum r, Enum l) => Comonad (Z3 c r l) where 33 | extract = view 34 | duplicate = layersToZ3 . widthWise . heightWise . depthWise 35 | where widthWise = fmap . fmap $ zipIterate zipL zipR <$> col <*> id 36 | heightWise = fmap $ zipIterate zipU zipD <$> row <*> id 37 | depthWise = zipIterate zipI zipO <$> level <*> id 38 | 39 | instance (Ord c, Ord r, Ord l, Enum c, Enum r, Enum l) => Zipper1 (Z3 c r l a) c where 40 | zipL = wrapZ3 $ fmap zipL 41 | zipR = wrapZ3 $ fmap zipR 42 | col = index . view . view . layersFromZ3 43 | 44 | instance (Ord c, Ord r, Ord l, Enum c, Enum r, Enum l) => Zipper2 (Z3 c r l a) r where 45 | zipU = wrapZ3 $ fmap zipU 46 | zipD = wrapZ3 $ fmap zipD 47 | row = index . view . layersFromZ3 48 | 49 | instance (Ord c, Ord r, Ord l, Enum c, Enum r, Enum l) => Zipper3 (Z3 c r l a) l where 50 | zipI = wrapZ3 zipL 51 | zipO = wrapZ3 zipR 52 | level = index . layersFromZ3 53 | 54 | instance (Ord c, Ord r, Ord l, Enum c, Enum r, Enum l) => RefOf (Ref c,Ref r,Ref l) (Z3 c r l a) [[[a]]] where 55 | slice (c,r,l) (c',r',l') = slice l l' . fmap (slice (c,r) (c',r')) . fromZ3 56 | insert list z = Z3 $ insert <$> (insert list (pure [])) <*> fromZ3 z 57 | go (colRef,rowRef,levelRef) = widthWise . heightWise . depthWise 58 | where 59 | widthWise = genericDeref zipL zipR col colRef 60 | heightWise = genericDeref zipU zipD row rowRef 61 | depthWise = genericDeref zipI zipO level levelRef 62 | 63 | instance (Ord c, Ord r, Ord l, Enum c, Enum r, Enum l) => AnyZipper (Z3 c r l a) (c,r,l) a where 64 | index = (,,) <$> col <*> row <*> level 65 | view = view . view . fromZ3 66 | write = wrapZ3 . modify . write 67 | reindex (c,r,l) = wrapZ3 (fmap (reindex (c,r)) . reindex l) 68 | -------------------------------------------------------------------------------- /Old/Z4.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} 2 | 3 | module Z4 4 | ( module Generic , Z4(..) , wrapZ4 5 | ) where 6 | 7 | import Generic 8 | import Z1 9 | import Z2 10 | import Z3 11 | 12 | newtype Z4 c r l s a = Z4 { fromZ4 :: Z1 s (Z3 c r l a) } 13 | 14 | wrapZ4 :: (Z1 s (Z3 c r l a) -> Z1 s' (Z3 c' r' l' a')) -> Z4 c r l s a -> Z4 c' r' l' s' a' 15 | wrapZ4 = (Z4 .) . (. fromZ4) 16 | 17 | layersFromZ4 :: Z4 c r l s a -> Z1 s (Z1 l (Z1 r (Z1 c a))) 18 | layersFromZ4 = (fmap . fmap) fromZ2 . fmap fromZ3 . fromZ4 19 | 20 | layersToZ4 :: Z1 s (Z1 l (Z1 r (Z1 c a))) -> Z4 c r l s a 21 | layersToZ4 = Z4 . fmap Z3 . (fmap . fmap) Z2 22 | 23 | instance Functor (Z4 c r l s) where 24 | fmap = wrapZ4 . fmap . fmap 25 | 26 | instance (Ord c, Ord r, Ord l, Ord s, Enum c, Enum r, Enum l, Enum s) => Applicative (Z4 c r l s) where 27 | fs <*> xs = Z4 $ fmap (<*>) (fromZ4 fs) <*> (fromZ4 xs) 28 | pure = Z4 . pure . pure 29 | 30 | instance (Ord c, Ord r, Ord l, Ord s, Enum c, Enum r, Enum l, Enum s) => ComonadApply (Z4 c r l s) where 31 | (<@>) = (<*>) 32 | 33 | instance (Ord c, Ord r, Ord l, Ord s, Enum c, Enum r, Enum l, Enum s) => Comonad (Z4 c r l s) where 34 | extract = view 35 | duplicate = layersToZ4 . widthWise . heightWise . depthWise . splissWise 36 | where widthWise = fmap . fmap . fmap $ zipIterate zipL zipR <$> col <*> id 37 | heightWise = fmap . fmap $ zipIterate zipU zipD <$> row <*> id 38 | depthWise = fmap $ zipIterate zipI zipO <$> level <*> id 39 | splissWise = zipIterate zipA zipK <$> space <*> id 40 | 41 | instance (Ord c, Ord r, Ord l, Ord s, Enum c, Enum r, Enum l, Enum s) => Zipper1 (Z4 c r l s a) c where 42 | zipL = wrapZ4 $ fmap zipL 43 | zipR = wrapZ4 $ fmap zipR 44 | col = index . view . view . view . layersFromZ4 45 | 46 | instance (Ord c, Ord r, Ord l, Ord s, Enum c, Enum r, Enum l, Enum s) => Zipper2 (Z4 c r l s a) r where 47 | zipU = wrapZ4 $ fmap zipU 48 | zipD = wrapZ4 $ fmap zipD 49 | row = index . view . view . layersFromZ4 50 | 51 | instance (Ord c, Ord r, Ord l, Ord s, Enum c, Enum r, Enum l, Enum s) => Zipper3 (Z4 c r l s a) l where 52 | zipI = wrapZ4 $ fmap zipI 53 | zipO = wrapZ4 $ fmap zipO 54 | level = index . view . layersFromZ4 55 | 56 | instance (Ord c, Ord r, Ord l, Ord s, Enum c, Enum r, Enum l, Enum s) => Zipper4 (Z4 c r l s a) s where 57 | zipA = wrapZ4 zipL 58 | zipK = wrapZ4 zipR 59 | space = index . layersFromZ4 60 | 61 | instance (Ord c, Ord r, Ord l, Ord s, Enum c, Enum r, Enum l, Enum s) => RefOf (Ref c,Ref r,Ref l,Ref s) (Z4 c r l s a) [[[[a]]]] where 62 | slice (c,r,l,s) (c',r',l',s') = slice s s' . fmap (slice (c,r,l) (c',r',l')) . fromZ4 63 | insert list z = Z4 $ insert <$> (insert list (pure [])) <*> fromZ4 z 64 | go (colRef,rowRef,levelRef,spaceRef) = widthWise . heightWise . depthWise . splissWise 65 | where 66 | widthWise = genericDeref zipL zipR col colRef 67 | heightWise = genericDeref zipU zipD row rowRef 68 | depthWise = genericDeref zipI zipO level levelRef 69 | splissWise = genericDeref zipA zipK space spaceRef 70 | 71 | instance (Ord c, Ord r, Ord l, Ord s, Enum c, Enum r, Enum l, Enum s) => AnyZipper (Z4 c r l s a) (c,r,l,s) a where 72 | index = (,,,) <$> col <*> row <*> level <*> space 73 | view = view . view . fromZ4 74 | write = wrapZ4 . modify . write 75 | reindex (c,r,l,s) = wrapZ4 (fmap (reindex (c,r,l)) . reindex s) 76 | -------------------------------------------------------------------------------- /Presentation/Presentation.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/plaidfinch/ComonadSheet/1cc9a91dc311bc1c692df4faaea091238b7871c2/Presentation/Presentation.pdf -------------------------------------------------------------------------------- /Presentation/TOC.txt: -------------------------------------------------------------------------------- 1 | A tale of two blog articles 2 | An unexpected journey 3 | (Co)monads: a brief summary 4 | A particular flavor of comonad 5 | Back to Piponi's `loeb` 6 | Fixed that for you 7 | Is this our fix? 8 | Well, sort of... 9 | Sharing is caring (as well as polynomial complexity) 10 | Holding on to the future 11 | Filling in the holes 12 | [picture: rainbow typing rule] 13 | Will it blend? 14 | Wait just a minute! 15 | What *is* a `ComonadApply` anyhow? 16 | Zippy comonads -> zippy computation 17 | Can going fast be total(ly safe)? 18 | But I'm more than a one-dimensional character 19 | Do you want to build a comonad? 20 | Type sleuth vs. the mysterious functor-swapper 21 | Mystery solved 22 | The story so far 23 | [picture: overlapping instances shark] 24 | Baby, there's a shark in the water 25 | GADTs to the rescue! 26 | Nest it / `fmap` it / quick rewrap it 27 | Drag and drop it / zip - unzip it 28 | He's making a list and checking it statically 29 | Take it / view it / go - insert it 30 | What have we learned? 31 | With great power comes code snippets for a tech talk 32 | [cabal install / github] 33 | -------------------------------------------------------------------------------- /Presentation/glider.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/plaidfinch/ComonadSheet/1cc9a91dc311bc1c692df4faaea091238b7871c2/Presentation/glider.png -------------------------------------------------------------------------------- /Presentation/make-presentation.sh: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | 3 | echo '\usepackage{pgfpages}\setbeameroption{show notes on second screen=right}' > with-notes.txt 4 | 5 | echo '\setbeameroption{hide notes}' > slides-only.txt 6 | 7 | pandoc -s -i -t beamer --variable fontsize=10pt --include-in-header slides-only.txt presentation.md -o presentation.pdf 8 | 9 | # pandoc -s -i -t beamer --variable fontsize=10pt --include-in-header with-notes.txt presentation.md -o presentation-notes.pdf 10 | 11 | rm slides-only.txt 12 | rm with-notes.txt 13 | -------------------------------------------------------------------------------- /Presentation/presentation.md: -------------------------------------------------------------------------------- 1 | \title{Getting a Quick Fix on Comonads} 2 | \subtitle{A quest to \texttt{extract} computation and not \texttt{duplicate} work} 3 | \author{Kenneth Foner\\\url{kenny.foner@gmail.com}} 4 | \institute{Brandeis University} 5 | \date{\today} 6 | 7 | \titlepage 8 | 9 | \note{ 10 | Hi, I'm Kenny Foner\dots 11 | 12 | This talk is about a journey I've been on\dots 13 | 14 | And in the telling of a journey, the best place to start is often the beginning. 15 | } 16 | 17 | # A tale of two blog articles 18 | 19 | Dan Piponi, November 2006 (`blog.sigfpe.com`): 20 | 21 | ### "From Löb's Theorem to Spreadsheet Evaluation" 22 | 23 | ```Haskell 24 | loeb :: Functor f => f (f a -> a) -> f a 25 | loeb fs = xs where xs = fmap ($ xs) fs 26 | ``` 27 | 28 | . . . 29 | 30 | Example: 31 | 32 | `> loeb [length, (!! 0), \x -> x !! 0 + x !! 1]`{.haskell} 33 | \vspace*{.9\baselineskip} 34 | 35 | \note{Beginning of journey: reading Dan Piponi's excellent blog. 36 | 37 | Explain loeb. 38 | } 39 | 40 | # A tale of two blog articles 41 | 42 | Dan Piponi, November 2006 (`blog.sigfpe.com`): 43 | 44 | ### "From Löb's Theorem to Spreadsheet Evaluation" 45 | 46 | ```Haskell 47 | loeb :: Functor f => f (f a -> a) -> f a 48 | loeb fs = xs where xs = fmap ($ xs) fs 49 | ``` 50 | 51 | Example: 52 | 53 | `> loeb [length, (!! 0), \x -> x !! 0 + x !! 1]`{.haskell} 54 | \newline 55 | `[3,3,6]`{.haskell} 56 | 57 | # A tale of two blog articles 58 | 59 | Dan Piponi, November 2006 (`blog.sigfpe.com`): 60 | 61 | ### "From Löb's Theorem to Spreadsheet Evaluation" 62 | 63 | ```Haskell 64 | loeb :: Functor f => f (f a -> a) -> f a 65 | loeb fs = xs where xs = fmap ($ xs) fs 66 | ``` 67 | 68 | Example: 69 | 70 | `> loeb [length, sum]`{.haskell} 71 | \vspace*{.9\baselineskip} 72 | 73 | \note{But what if we try to evaluate this expression?} 74 | 75 | # A tale of two blog articles 76 | 77 | Dan Piponi, November 2006 (`blog.sigfpe.com`): 78 | 79 | ### "From Löb's Theorem to Spreadsheet Evaluation" 80 | 81 | ```Haskell 82 | loeb :: Functor f => f (f a -> a) -> f a 83 | loeb fs = xs where xs = fmap ($ xs) fs 84 | ``` 85 | 86 | Example: 87 | 88 | `> loeb [length, sum]`{.haskell} 89 | \newline 90 | $\bot$ 91 | 92 | # A tale of two blog articles 93 | 94 | Dan Piponi, December 2006 (`blog.sigfpe.com`): 95 | 96 | ### "Evaluating Cellular Automata is Comonadic" 97 | 98 | > I want to work on 'universes' that extend to infinity in both directions. And I want this universe to be constructed lazily on demand. 99 | 100 | > We can think of a universe with the cursor pointing at a particular element as being an element with a neighbourhood on each side. 101 | 102 | \note{All that was fascinating. But the true beginning was when I read a second post, also by Dan Piponi. 103 | 104 | Thank you, Dan.} 105 | 106 | # An unexpected journey 107 | 108 | ```Haskell 109 | loeb :: Functor f => f (f a -> a) -> f a 110 | loeb fs = xs where xs = fmap ($ xs) fs 111 | ``` 112 | 113 | > - `loeb`: each element refers to *absolute positions* in a structure 114 | > - comonads: computations in context of *relative position* in a structure 115 | 116 | These are almost the same thing! 117 | 118 | \note{This talk is about my quest to find that missing \emph{je ne sais quoi} and unify these two notions.} 119 | 120 | # (Co)monads: a brief summary 121 | 122 | ### Monads: 123 | 124 | Most Haskellers define monads via `return` and `(>>=)`{.haskell}. Today, we'll use `return` and `join`. *Note:* `x >>= f == join (fmap f x)`{.haskell}. 125 | 126 | ```Haskell 127 | class Functor m => Monad m where 128 | return :: a -> m a 129 | join :: m (m a) -> m a 130 | ``` 131 | 132 | . . . 133 | 134 | ### Comonads: 135 | 136 | ```Haskell 137 | class Functor w => Comonad w where 138 | extract :: w a -> a -- a.k.a. coreturn 139 | duplicate :: w a -> w (w a) -- a.k.a. cojoin 140 | ``` 141 | 142 | (from Edward Kmett's `Control.Comonad`) 143 | 144 | \note{Before I go any further, I want to give a quick summary of comonads. They're the star of this show. 145 | 146 | Perhaps I should say coproductary instead of summary, for you category theory folk. 147 | 148 | I'm ignoring extend (cobind) for the same reason as why I'm ignoring bind: things today will make more sense in terms of return/coreturn and join/cojoin.} 149 | 150 | 169 | 170 | # A particular flavor of comonad 171 | 172 | ```Haskell 173 | data Stream a = Cons a (Stream a) -- no nil! 174 | ``` 175 | 176 | (from Wouter Swierstra's `Data.Stream`) 177 | 178 | . . . 179 | 180 | ```Haskell 181 | head :: Stream a -> a 182 | head (Cons x _) = x 183 | 184 | tail :: Stream a -> Stream a 185 | tail (Cons _ xs) = xs 186 | 187 | iterate :: (a -> a) -> a -> Stream a 188 | iterate f x = Cons x (iterate f (f x)) 189 | ``` 190 | 191 | \note{In particular, most of the comonadic structures I'll be talking about are based off a very simple data structure. 192 | 193 | Note that `head` and `tail` are total functions.} 194 | 195 | # A particular flavor of comonad 196 | 197 | ```Haskell 198 | data Tape a = (Stream a) a (Stream a) 199 | ``` 200 | 201 | \note{It's infinite in both directions, like a Turing-machine's... `Tape`.} 202 | 203 | . . . 204 | 205 | ```Haskell 206 | moveL, moveR :: Tape a -> Tape a 207 | moveL (Tape (Cons l ls) c rs) = 208 | Tape ls l (Cons c rs) 209 | moveR (Tape ls c (Cons r rs)) = 210 | Tape (Cons c ls) r rs 211 | ``` 212 | 213 | . . . 214 | 215 | ```Haskell 216 | iterate :: (a -> a) -> (a -> a) -> a -> Tape a 217 | iterate prev next x = 218 | Tape (Stream.iterate prev x) x (Stream.iterate next x) 219 | ``` 220 | 221 | \note{Using the stream type, we can create something more interesting. 222 | 223 | Streams have no notion of the past, only the future; they can only look in one direction. 224 | 225 | Tapes are a bidirectional stream, also known as a stream zipper.} 226 | 227 | # A particular flavor of comonad 228 | 229 | ```Haskell 230 | instance Comonad Tape where 231 | extract (Tape _ c _) = c 232 | duplicate = iterate moveL moveR 233 | ``` 234 | 235 | . . . 236 | 237 | Duplicate is "diagonalization." Movement and duplication commute: 238 | 239 | ```Haskell 240 | moveL . duplicate == duplicate . moveL 241 | moveR . duplicate == duplicate . moveR 242 | ``` 243 | 244 | \note{They have a more satisfying comonad instance than streams, IMO. 245 | 246 | I have a hand-wavy proof that this is the only definition of `duplicate` which satisfies the comonad laws for `Tape`. 247 | 248 | (I welcome proofs using more category theory than gesticulation.)} 249 | 250 | # Back to Piponi's `loeb` 251 | 252 | Löb's theorem: $\Box(\Box P \to P) \to \Box P$ 253 | 254 | > I'm going to take that as my theorem from which I'll derive a type. But what should $\Box$ become in Haskell? 255 | 256 | > We'll defer that decision until later and assume as little as possible. Let's represent $\Box$ by a type that is a Functor. 257 | 258 | (Piponi, 2006) 259 | 260 | . . . 261 | 262 | ```Haskell 263 | loeb :: Functor f => f (f a -> a) -> f a 264 | ``` 265 | 266 | . . . 267 | 268 | But $\Box$ could also have more structure... 269 | 270 | \note{ 271 | Now let's get back to Piponi's loeb function. He takes Lob's theorem from modal logic, and decides to find a computational interpretation of it. 272 | } 273 | 274 | # Fixed that for you 275 | 276 | ```Haskell 277 | loeb :: Functor f => f (f a -> a) -> f a 278 | loeb fs = xs where xs = fmap ($ xs) fs 279 | ``` 280 | 281 | . . . 282 | 283 | ```Haskell 284 | fix :: (a -> a) -> a 285 | fix f = let x = f x in x 286 | ``` 287 | 288 | . . . 289 | 290 | We can redefine Piponi's `loeb` in terms of `fix`: 291 | 292 | ```Haskell 293 | loeb :: Functor f => f (f a -> a) -> f a 294 | loeb fs = fix $ \xs -> fmap ($ xs) fs 295 | ``` 296 | 297 | I'll use this one from now on. 298 | 299 | # Fixed that for you 300 | 301 | ```Haskell 302 | loeb :: Functor f => f (f a -> a) -> f a 303 | loeb fs = fix $ \xs -> fmap ($ xs) fs 304 | ``` 305 | 306 | We want to find: 307 | 308 | `???? :: Comonad w => w (w a -> a) -> w a`{.haskell} 309 | 310 | . . . 311 | 312 | \vspace*{.45\baselineskip} 313 | 314 | `cfix :: Comonad w => (w a -> a) -> w a`{.haskell} 315 | 316 | \vspace*{1.43\baselineskip} 317 | 318 | . . . 319 | 320 | `wfix :: Comonad w => w (w a -> a) -> a`{.haskell} 321 | 322 | \vspace*{1.51\baselineskip} 323 | 324 | # Fixed that for you 325 | 326 | ```Haskell 327 | loeb :: Functor f => f (f a -> a) -> f a 328 | loeb fs = fix $ \xs -> fmap ($ xs) fs 329 | ``` 330 | 331 | We want to find: 332 | 333 | `???? :: Comonad w => w (w a -> a) -> w a`{.haskell} 334 | 335 | ```Haskell 336 | cfix :: Comonad w => (w a -> a) -> w a 337 | cfix f = fix (fmap f . duplicate) 338 | ``` 339 | 340 | ```Haskell 341 | wfix :: Comonad w => w (w a -> a) -> a 342 | wfix w = extract w (fmap wfix (duplicate w)) 343 | ``` 344 | 345 | # Is this our fix? 346 | 347 | ```Haskell 348 | possibility :: Comonad w => w (w a -> a) -> w a 349 | possibility = fmap wfix . duplicate 350 | ``` 351 | 352 | . . . 353 | 354 | It type-checks, so it has to be right! Right? 355 | 356 | # Well, sort of\dots 357 | 358 | . . . 359 | 360 | Let's try to count to 10000! 361 | 362 | ```Haskell 363 | main = print . S.take 10000 . viewR . possibility $ 364 | Tape (S.repeat (const 0)) -- zero left of origin 365 | (const 0) -- zero at origin 366 | (S.repeat -- right of origin: 367 | (succ . extract . moveL)) -- 1 + leftward value 368 | ``` 369 | 370 | (This syntax gets more elegant later.) 371 | 372 | # Well, sort of\dots 373 | 374 | `$ time ./possibility` 375 | 376 | . . . 377 | 378 | ``` 379 | [0,1,2,3,4 ... some time later ... 9998, 9999, 10000] 380 | 39.49 real 38.87 user 0.38 sys 381 | ``` 382 | 383 | . . . 384 | 385 | 256 increment operations per second. 386 | 387 | (And this gets worse—it's not linear\dots) 388 | 389 | # Sharing is caring (as well as polynomial complexity) 390 | 391 | ```Haskell 392 | wfix :: Comonad w => w (w a -> a) -> a 393 | wfix w = extract w (fmap wfix (duplicate w)) 394 | ``` 395 | 396 | ```Haskell 397 | possibility :: Comonad w => w (w a -> a) -> w a 398 | possibility = fmap wfix . duplicate 399 | ``` 400 | 401 | . . . 402 | 403 | - No sharing: computation is shaped like a tree, not a DAG 404 | 405 | - Count all the way up from zero for each number, so $O(n^2)$ 406 | 407 | - In a higher-dimensional space with $> 1$ reference per cell, would be exponential or worse. 408 | 409 | 410 | 411 | . . . 412 | 413 | That really `succ`s. 414 | 415 | # Sharing is caring (as well as polynomial complexity) 416 | 417 | ```Haskell 418 | wfix :: Comonad w => w (w a -> a) -> a 419 | wfix w = extract w (fmap wfix (duplicate w)) 420 | ``` 421 | 422 | The root of the problem: `wfix` can't be expressed in terms of `fix`. 423 | 424 | . . . 425 | 426 | 427 | 428 | ```Haskell 429 | notWhatI'mTalkingAbout :: Comonad w => w (w a -> a) -> a 430 | notWhatI'mTalkingAbout = 431 | fix $ \wfix -> 432 | \w -> extract w (fmap wfix (duplicate w)) 433 | ``` 434 | 435 | # Holding on to the future 436 | 437 | ```Haskell 438 | wfix :: Comonad w => w (w a -> a) -> a 439 | wfix w = extract w (fmap wfix (duplicate w)) 440 | ``` 441 | 442 | More specifically: `wfix` is inexpressible in terms of `fix` on its *argument*. 443 | 444 | Why does this mean it's inefficient? 445 | 446 | \vspace*{1.5\baselineskip} 447 | 448 | . . . 449 | 450 | No single reference to the eventual future of the computation. 451 | 452 | # Holding on to the future 453 | 454 | **Epiphany**: Any efficient "evaluation" function looks like: 455 | 456 | ```Haskell 457 | evaluate :: Comonad w => w (w a -> a) -> w a 458 | evaluate fs = fix $ _ 459 | ``` 460 | 461 | 462 | 463 | 464 | 465 | # Filling in the holes 466 | 467 | ```Haskell 468 | evaluate :: Comonad w => w (w a -> a) -> w a 469 | evaluate fs = fix $ _ 470 | ``` 471 | 472 | . . . 473 | 474 | \texttt{Found hole with type: \color{purple}w a -> w a} 475 | 476 | (Error messages have been cleaned for your viewing enjoyment.) 477 | 478 | \vspace*{5.75\baselineskip} 479 | 480 | \note{All of the previous comonadic fixed-points we were using duplicated their argument, so that each location can consume a version of the final structure located at its own position. Let's stick a duplicate in here.} 481 | 482 | # Filling in the holes 483 | 484 | ```Haskell 485 | evaluate :: Comonad w => w (w a -> a) -> w a 486 | evaluate fs = fix $ _ . duplicate 487 | ``` 488 | 489 | . . . 490 | 491 | \texttt{Found hole with type: \color{purple}w (w a) -> w a} 492 | 493 | \vspace*{7.25\baselineskip} 494 | 495 | \note{So we've got something of type w (w a $\to$ a) -- our input -- and we'll *be given* something of type w (w a) -- by the fixed-point operator -- and we need to synthesize something of type (w a) from those two.} 496 | 497 | \note{Let's put our fs argument in as an argument to our hole: we know it has to be used somewhere, and it's gotta be there.} 498 | 499 | # Filling in the holes 500 | 501 | ```Haskell 502 | evaluate :: Comonad w => w (w a -> a) -> w a 503 | evaluate fs = fix $ _ fs . duplicate 504 | ``` 505 | 506 | . . . 507 | 508 | \texttt{Found hole with type: \color{purple}w (w a -> a) -> w (w a) -> w a} 509 | 510 | \vspace*{7.25\baselineskip} 511 | 512 | \note{Hoogling this exact type signature doesn't work, but if we replace (w a) in the above with some arbitrary type b, this looks exactly like the Applicative pattern! f (b $\to$ a) $\to$ f b $\to$ f a. And Hoogle will now happily tell us that there's a version of Applicative for comonads: ComonadApply.} 513 | 514 | # Filling in the holes 515 | 516 | ```Haskell 517 | evaluate :: Comonad w => w (w a -> a) -> w a 518 | evaluate fs = fix $ (fs <@>) . duplicate 519 | ``` 520 | 521 | `(<@>) :: ComonadApply w => w (a -> b) -> w a -> w b`{.haskell} 522 | 523 | . . . 524 | 525 | ``` 526 | Could not deduce (ComonadApply w) 527 | arising from a use of ‘<@>’ 528 | Possible fix: 529 | add (ComonadApply w) to the context 530 | of the type signature for evaluate. 531 | ``` 532 | 533 | \note{Oh, obviously: we need to fix that constraint now.} 534 | 535 | # Filling in the holes 536 | 537 | \vspace*{3.4\baselineskip} 538 | 539 | ```Haskell 540 | evaluate :: ComonadApply w => w (w a -> a) -> w a 541 | evaluate fs = fix $ (fs <@>) . duplicate 542 | ``` 543 | 544 | `(<@>) :: ComonadApply w => w (a -> b) -> w a -> w b`{.haskell} 545 | 546 | \vspace*{12.5\baselineskip} 547 | 548 | # 549 | 550 | \begin{center} 551 | \includegraphics[width=\textwidth]{Rainbow.jpg} 552 | \end{center} 553 | 554 | \note{We just derived our comonadic fixed point, in the process discovering a necessary and sufficient condition for its efficiency. Thanks, type inference!} 555 | 556 | # Will it blend? 557 | 558 | Let's try to count to 10000\dots again! 559 | 560 | ```Haskell 561 | evaluate :: ComonadApply w => w (w a -> a) -> w a 562 | evaluate fs = fix $ (fs <@>) . duplicate 563 | 564 | main = print . S.take 10000 . viewR . evaluate $ 565 | Tape (S.repeat (const 0)) -- zero left of origin 566 | (const 0) -- zero at origin 567 | (S.repeat -- right of origin: 568 | (succ . extract . moveL)) -- 1 + leftward value 569 | ``` 570 | 571 | # Will it blend? 572 | 573 | `$ time ./evaluate` 574 | 575 | . . . 576 | 577 | ``` 578 | [0,1,2,3,4 ... a blur on the screen ... 9999, 10000] 579 | 0.01 real 0.00 user 0.00 sys 580 | ``` 581 | 582 | . . . 583 | 584 | Still very slightly slower than `take 10000 [1..]`{.haskell}, almost certainly because GHC fuses away the intermediate list. 585 | 586 | **Aside**: list fusion in `evaluate`: reducible to halting problem? 587 | 588 | # Wait just a minute! 589 | 590 | "Hang on, Kenny! We don't know why `Tape`s are `ComonadApply`!" 591 | 592 | . . . 593 | 594 | ```Haskell 595 | instance ComonadApply Tape where 596 | (Tape ls c rs) <@> (Tape ls' c' rs') = 597 | Tape (ls <@> ls') (c c') (rs <@> rs') 598 | ``` 599 | 600 | . . . 601 | 602 | "But that relies on the `ComonadApply` instance for `Stream`s!" 603 | 604 | \note{How are you doing that thing where you speak in monospace fonts, anonymous interrogator? Anyhow...} 605 | 606 | . . . 607 | 608 | ```Haskell 609 | instance ComonadApply Stream where (<@>) = (<*>) 610 | ``` 611 | 612 | . . . 613 | 614 | ```Haskell 615 | instance Applicative Stream where 616 | pure = repeat 617 | (<*>) = zipWith ($) 618 | ``` 619 | 620 | \note{If something is both an Applicative and a ComonadApply, we have to make the two 'apply' operations equivalent. Edward Kmett says so.} 621 | 622 | # What *is* a `ComonadApply` anyhow? 623 | 624 | \note{Speaking of other things Edward Kmett says:} 625 | 626 | . . . 627 | 628 | *It is a strong lax symmetric semi-monoidal comonad on the category Hask of Haskell types. That it to say that w is a strong lax symmetric semi-monoidal functor on Hask, where both extract and duplicate are symmetric monoidal natural transformations.* 629 | \newline 630 | \hspace*{.5em} 631 | —Edward Kmett 632 | 633 | \vspace*{1\baselineskip} 634 | 635 | . . . 636 | 637 | *ComonadApply is to Comonad like Applicative is to Monad.* 638 | \newline 639 | \hspace*{.5em} 640 | —Edward Kmett 641 | 642 | # What *is* a `ComonadApply` anyhow? 643 | 644 | ### The laws of `ComonadApply`: 645 | 646 | ```Haskell 647 | (.) <$> u <@> v <@> w == u <@> (v <@> w) 648 | extract (p <@> q) == extract p (extract q) 649 | duplicate (p <@> q) == (<@>) <$> duplicate p <@> duplicate q 650 | ``` 651 | 652 | . . . 653 | 654 | These laws mean `(<@>)`{.haskell} *must* be "zippy." 655 | 656 | 657 | 658 | . . . 659 | 660 | Uustalu and Vene's *The Essence of Dataflow Programming* calls it: 661 | 662 | \ \ \ \ \ `czip :: (ComonadZip d) => d a -> d b -> d (a,b)`{.haskell} 663 | 664 | . . . 665 | 666 | **Enlightening exercise:** for an arbitrary `Functor f`, show how `czip` and `(<@>)`{.haskell} can be defined in terms of each other and `fmap`. 667 | 668 | # Zippy comonads $\to$ zippy computation 669 | 670 | \large The "zippiness" required by the laws of `ComonadApply` leads to `evaluate`'s *computational* "zippiness." 671 | 672 | 673 | 674 | # Can going fast be total(ly safe)? 675 | 676 | . . . 677 | 678 | \large Short answer: no. 679 | 680 | \large Long answer: not in ways we would care about. 681 | 682 | # But I'm more than a one-dimensional character 683 | 684 | \note{Now that we have an efficient evaluation function, the next step is to see what things we can evaluate!} 685 | 686 | . . . 687 | 688 | Nesting `Tape`s inside one another leads us into to higher-dimensional (discrete) spaces to explore. 689 | \newline 690 | 691 | `Tape a`\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ $\cong$ `Integer` $\to$ a 692 | 693 | `Tape (Tape a)`\ \ \ \ \ \ \ \ \ \ \ \ $\cong$ `(Integer,Integer)` $\to$ a 694 | 695 | `Tape (Tape (Tape a))`\ $\cong$ `(Integer,Integer,Integer)` $\to$ a 696 | 697 | Etcetera, ad infinitum! 698 | 699 | # But I'm more than a one-dimensional character 700 | 701 | We could define a `newtype` for each added dimension, but this carries an overhead of between $O(n^2)$ and $O(n^3)$ boilerplate per dimension. 702 | 703 | . . . 704 | 705 | ```Haskell 706 | newtype Tape2 a = Tape (Tape a) 707 | newtype Tape3 a = Tape (Tape (Tape a)) 708 | ... 709 | ``` 710 | 711 | ```Haskell 712 | instance Functor Tape2 where ... 713 | instance Comonad Tape2 where ... 714 | instance ComonadApply Tape2 where ... 715 | 716 | instance Functor Tape3 where ... 717 | instance Comonad Tape3 where ... 718 | instance ComonadApply Tape3 where ... 719 | ... 720 | ``` 721 | 722 | That also really `succ`s. 723 | 724 | # But I'm more than a one-dimensional character 725 | 726 | 727 | 728 | Composition of functors (from `Data.Functor.Compose`): 729 | 730 | ```Haskell 731 | newtype Compose f g a = Compose { getCompose :: f (g a) } 732 | 733 | (Functor f, Functor g) => Functor (Compose f g) 734 | (Applicative f, Applicative g) => Applicative (Compose f g) 735 | ``` 736 | 737 | . . . 738 | 739 | ```Haskell 740 | instance (Comonad f, Comonad g) => Comonad (Compose f g) where 741 | extract = extract . extract . getCompose 742 | duplicate = ... 743 | ``` 744 | 745 | 746 | 747 | # Do you want to build a comonad? 748 | 749 | (N.B. In this section, I've specialized many type signatures.) 750 | 751 | **What can you do with `(Compose f g a)`{.haskell}?** 752 | 753 | . . . 754 | 755 | Equivalent: what can you do with `(Comonad f, Comonad g) => f (g a)`{.haskell}? 756 | 757 | . . . 758 | 759 | **Duplicate outer layer:** 760 | 761 | `duplicate :: f (g a) -> f (f (g a))`{.haskell} 762 | 763 | . . . 764 | 765 | **Duplicate inner layer:** 766 | 767 | `fmap duplicate :: f (g a) -> f (g (g a))`{.haskell} 768 | 769 | . . . 770 | 771 | **Duplicate both:** 772 | 773 | `duplicate . fmap duplicate :: f (g a) -> f (f (g (g a)))`{.haskell} 774 | 775 | # Do you want to build a comonad? 776 | 777 | If only we had `f (f (g (g a))) -> f (g (f (g a)))`{.haskell}\dots 778 | 779 | ```Haskell 780 | Compose . fmap Compose -- wrap again 781 | . ??? -- swap middle two layers 782 | . duplicate -- duplicate outside 783 | . fmap duplicate -- duplicate inside 784 | . getCompose -- unwrap 785 | :: Compose f g a -> Compose f g (Compose f g a) 786 | ``` 787 | 788 | \note{But what's the mystery function\dots?} 789 | 790 | # Type sleuth vs. the mysterious functor-swapper 791 | 792 | Whatever `???` is, it likely has a more generic type. 793 | 794 | \note{Let's guess that we're looking for something which swaps just two layers.} 795 | 796 | . . . 797 | 798 | ```Haskell 799 | ??? :: f (g x) -> g (f x) 800 | fmap ??? :: f (f (g (g a))) -> f (g (f (g a))) 801 | ``` 802 | 803 | . . . 804 | 805 | ```Haskell 806 | Compose . fmap Compose -- wrap again 807 | . fmap ??? -- swap middle two layers 808 | . duplicate -- duplicate outside 809 | . fmap duplicate -- duplicate inside 810 | . getCompose -- unwrap 811 | :: Compose f g a -> Compose f g (Compose f g a) 812 | ``` 813 | 814 | # Type sleuth vs. the mysterious functor-swapper 815 | 816 | Two candidates (thanks Hoogle!): 817 | 818 | ```Haskell 819 | sequenceA -- from Data.Traversable 820 | :: (Traversable t, Applicative f) => t (f a) -> f (t a) 821 | 822 | distribute -- from Data.Distributive 823 | :: (Distributive g, Functor f) => f (g a) -> g (f a) 824 | ``` 825 | 826 | # Type sleuth vs. the mysterious functor-swapper 827 | 828 | ```Haskell 829 | sequenceA -- from Data.Traversable 830 | :: (Traversable t, Applicative f) => t (f a) -> f (t a) 831 | ``` 832 | 833 | Initially promising—I know and love `Traversable`. 834 | 835 | . . . 836 | 837 | Requires two constraints: 838 | 839 | > - `Applicative f`: outer layer has to have `(<*>)`{.haskell} and `pure`—`pure` is a hard pill to swallow. 840 | > - `Traversable t`—that's a deal-breaker! 841 | 842 | . . . 843 | 844 | Jaskelioff & Rypacek, MSFP 2012, "An Investigation of the Laws of Traversals": "We are not aware of any functor that is traversable and is not a finitary container." 845 | 846 | - Infinite streams are definitely not `Traversable`. 847 | 848 | # Type sleuth vs. the mysterious functor-swapper 849 | 850 | ```Haskell 851 | distribute -- from Data.Distributive 852 | :: (Distributive g, Functor f) => f (g a) -> g (f a) 853 | ``` 854 | 855 | But what does `Distributive` mean? 856 | 857 | . . . 858 | 859 | What can you do underneath a `Functor`? 860 | 861 | . . . 862 | 863 | "Touch, don't look." 864 | 865 | # Type sleuth vs. the mysterious functor-swapper 866 | 867 | ```Haskell 868 | distribute -- from Data.Distributive 869 | :: (Distributive g, Functor f) => f (g a) -> g (f a) 870 | ``` 871 | 872 | Strategy/intuition for `distribute`: 873 | 874 | > - Start with `f (g a)` 875 | > - Create a `g` with `f (g a)` in each 'hole': `g (f (g a))` 876 | > - For each `f (g a)` on the inside of `g`: 877 | > + navigate to a particular focus (using `fmap`) 878 | > + `fmap extract` to eliminate the inner `g` 879 | > - Result: `g (f a)` 880 | 881 | \note{What do we need to have a Distributive? 882 | 883 | We already know f is a functor; it's a comonad! And Distributive only has Functor as a superclass, so we're good there too. 884 | 885 | You can think of the Functor interface as a one-way membrane which lets us "send commands" to the thing inside the box, but not ask it anything about itself. 886 | 887 | So we can't get information out: all things of type `g` must have identical structure. Streams, length-indexed lists, and functions are all distributive, but not lists or finite trees.} 888 | 889 | # Mystery solved 890 | 891 | ```Haskell 892 | instance (Comonad f, Comonad g, Distributive g) 893 | => Comonad (Compose f g) where 894 | extract = extract . extract . getCompose 895 | duplicate = Compose . fmap Compose -- wrap again 896 | . distribute -- swap middle two layers 897 | . duplicate -- duplicate outside 898 | . fmap duplicate -- duplicate inside 899 | . getCompose -- unwrap 900 | ``` 901 | 902 | # Mystery solved 903 | 904 | ```Haskell 905 | unfold prev center next x = 906 | Tape (S.unfold prev x) (center x) (S.unfold next x) 907 | 908 | instance Distributive Tape where 909 | distribute = 910 | unfold (fmap (focus . moveL) &&& fmap moveL) 911 | (fmap focus) 912 | (fmap (focus . moveR) &&& fmap moveR) 913 | ``` 914 | 915 | \note{All the comonads we want to talk about (Tapes and Streams and their ilk) are of fixed cardinality (i.e. countable infinity), with no extra information. 916 | 917 | The triple-ampersand operator is from Control.Arrow; it makes a function which takes something and returns a pair consisting of the results of applying each of its two function arguments to that something.} 918 | 919 | # The story so far 920 | 921 | . . . 922 | 923 | Efficient evaluation: 924 | 925 | ```Haskell 926 | evaluate :: ComonadApply w => w (w a -> a) -> w a 927 | ``` 928 | 929 | . . . 930 | 931 | Elegant composition: 932 | 933 | ```Haskell 934 | (Comonad f, Comonad g, Distributive g) => Comonad (Compose f g) 935 | ``` 936 | 937 | . . . 938 | 939 | I could make a library out of this! 940 | 941 | \note{First, though, some ugly truths have to be brought to light.} 942 | 943 | # 944 | 945 | \begin{center} 946 | \includegraphics[width=\textwidth]{shark-fin-ocean.jpg} 947 | \end{center} 948 | 949 | # Baby, there's a shark in the water 950 | 951 | ```Haskell 952 | type family ComposeCount f where 953 | ComposeCount (Compose f g a) = Succ (ComposeCount (f (g a))) 954 | ComposeCount x = Zero 955 | 956 | class CountCompose f where 957 | countCompose :: f -> ComposeCount f 958 | ``` 959 | 960 | \vspace{3.75\baselineskip} 961 | 962 | # Baby, there's a shark in the water 963 | 964 | ```Haskell 965 | {-# LANGUAGE FeelBadAboutYourself #-} 966 | 967 | type family ComposeCount f where 968 | ComposeCount (Compose f g a) = Succ (ComposeCount (f (g a))) 969 | ComposeCount x = Zero 970 | 971 | class CountCompose f where 972 | countCompose :: f -> ComposeCount f 973 | ``` 974 | 975 | \vspace{6.75\baselineskip} 976 | 977 | # Baby, there's a shark in the water 978 | 979 | ```Haskell 980 | {-# LANGUAGE OverlappingInstances #-} 981 | 982 | type family ComposeCount f where 983 | ComposeCount (Compose f g a) = Succ (ComposeCount (f (g a))) 984 | ComposeCount x = Zero 985 | 986 | class CountCompose f where 987 | countCompose :: f -> ComposeCount f 988 | ``` 989 | 990 | . . . 991 | 992 | ```Haskell 993 | instance (CountCompose (f (g a))) 994 | => CountCompose (Compose f g a) where 995 | countCompose (Compose x) = Succ (countCompose x) 996 | ``` 997 | 998 | . . . 999 | 1000 | ```Haskell 1001 | instance (ComposeCount f ~ Zero) => CountCompose f where 1002 | countCompose _ = Zero 1003 | ``` 1004 | 1005 | # GADTs to the rescue! 1006 | 1007 | Previously: 1008 | 1009 | ```Haskell 1010 | newtype Compose f g a = { getCompose :: f (g a) } 1011 | ``` 1012 | 1013 | . . . 1014 | 1015 | What if we put *depth of nesting* in the types? 1016 | 1017 | ```Haskell 1018 | data Flat x 1019 | data Nest o i 1020 | 1021 | data Nested fs a where 1022 | Flat :: f a -> Nested (Flat f) a 1023 | Nest :: Nested fs (f a) -> Nested (Nest fs f) a 1024 | ``` 1025 | 1026 | . . . 1027 | 1028 | ```Haskell 1029 | Just [1] :: Maybe [Int] 1030 | Flat (Just [1]) :: Nested (Flat Maybe) [Int] 1031 | Nest (Flat (Just [1])) :: Nested (Nest (Flat Maybe) []) Int 1032 | ``` 1033 | 1034 | # Nest it / `fmap` it / quick rewrap it 1035 | 1036 | Two cases for each instance (base case/recursive case): 1037 | 1038 | ```Haskell 1039 | instance (Functor f) => Functor (Nested (Flat f)) where 1040 | fmap f (Flat x) = Flat $ fmap f x 1041 | 1042 | instance (Functor f, Functor (Nested fs)) 1043 | => Functor (Nested (Nest fs f)) where 1044 | fmap f (Nest x) = Nest $ fmap (fmap f) x 1045 | ``` 1046 | 1047 | Other typeclass instances are likewise defined in two parts. 1048 | 1049 | # Nest it / `fmap` it / quick rewrap it 1050 | 1051 | > - Match on types, not constraints 1052 | > - Base case is `Flat`, not every type, so no "universal instance" 1053 | > - See ya later, `OverlappingInstances`! 1054 | 1055 | # Drag and drop it / zip - unzip it 1056 | 1057 | ### What's in a reference? 1058 | 1059 | . . . 1060 | 1061 | ```Haskell 1062 | {-# LANGUAGE DataKinds #-} 1063 | 1064 | data RefType = Relative | Absolute 1065 | 1066 | data Ref (t :: RefType) where 1067 | Rel :: Int -> Ref Relative 1068 | Abs :: Int -> Ref Absolute 1069 | ``` 1070 | 1071 | # Drag and drop it / zip - unzip it 1072 | 1073 | ```Haskell 1074 | type family Combine a b where 1075 | Combine Relative Absolute = Absolute 1076 | Combine Absolute Relative = Absolute 1077 | Combine Relative Relative = Relative 1078 | ``` 1079 | 1080 | 1081 | 1082 | ```Haskell 1083 | class CombineRefs a b where 1084 | combine :: Ref a -> Ref b -> Ref (Combine a b) 1085 | ``` 1086 | 1087 | 1088 | 1089 | 1090 | 1091 | # He's making a list and checking it statically 1092 | 1093 | ```Haskell 1094 | data x :-: y 1095 | data Nil 1096 | 1097 | data ConicList f ts where 1098 | (:-:) :: f x -> ConicList f xs -> ConicList f (x :-: xs) 1099 | ConicNil :: ConicList f Nil 1100 | 1101 | type RefList = ConicList Ref 1102 | ``` 1103 | 1104 | # He's making a list and checking it statically 1105 | 1106 | ```Haskell 1107 | type family a & b where 1108 | (a :-: as) & (b :-: bs) = Combine a b :-: (as & bs) 1109 | Nil & bs = bs 1110 | as & Nil = as 1111 | ``` 1112 | 1113 | ```Haskell 1114 | class CombineRefLists as bs where 1115 | (&) :: RefList as -> RefList bs -> RefList (as & bs) 1116 | ``` 1117 | 1118 | 1119 | 1120 | # He's making a list and checking it statically 1121 | 1122 | With suitable definition of names\dots 1123 | 1124 | ```Haskell 1125 | a :: RefList (Relative :-: Relative :-: Nil) 1126 | a = belowBy 3 & rightBy 14 1127 | ``` 1128 | 1129 | . . . 1130 | 1131 | ```Haskell 1132 | b :: RefList (Relative :-: Absolute :-: Nil) 1133 | b = columnAt 9000 & aboveBy 1 1134 | ``` 1135 | 1136 | . . . 1137 | 1138 | \color{red}\texttt{c = columnAt 5 \& columnAt 10} 1139 | 1140 | # Take it / view it / go - insert it 1141 | 1142 | ```Haskell 1143 | class Take r t where 1144 | type ListFrom t a 1145 | take :: RefList r -> t a -> ListFrom t a 1146 | 1147 | class View r t where 1148 | type StreamFrom t a 1149 | view :: RefList r -> t a -> StreamFrom t a 1150 | 1151 | class Go r t where 1152 | go :: RefList r -> t a -> t a 1153 | ``` 1154 | 1155 | . . . 1156 | 1157 | \dots and `insert` --- I have discovered a truly marvelous type signature for this, which this margin is too narrow to contain. 1158 | 1159 | # What have we learned? 1160 | 1161 | > - Efficient comonadic fixed-point requires zipping 1162 | > - Distributive comonads compose 1163 | > - Dimension polymorphism needs type-indexed composition 1164 | > - Heterogeneous lists unify absolute and relative references 1165 | 1166 | . . . 1167 | 1168 | - (Co)monads are (co)ol! 1169 | 1170 | 1171 | 1172 | # With great power comes code snippets for a tech talk 1173 | 1174 | ```Haskell 1175 | fibonacci :: Sheet1 Integer 1176 | fibonacci = evaluate . sheet 1 $ 1177 | repeat $ cell (leftBy 2) + cell left 1178 | ``` 1179 | 1180 | (I told you the syntax would get nicer!) 1181 | 1182 | . . . 1183 | 1184 | ```Haskell 1185 | > slice (leftBy 2) (rightBy 17) fibonacci 1186 | [1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584] 1187 | ``` 1188 | 1189 | # With great power comes code snippets for a tech talk 1190 | 1191 | 1192 | 1193 | ```Haskell 1194 | pascal :: Sheet2 Integer 1195 | pascal = evaluate . sheet 0 $ 1196 | repeat 1 <:> repeat (1 <:> pascalRow) 1197 | where pascalRow = repeat $ cell above + cell left 1198 | ``` 1199 | 1200 | . . . 1201 | 1202 | ```Haskell 1203 | > take (belowBy 9 & rightBy 9) pascal 1204 | ``` 1205 | 1206 | . . . 1207 | 1208 | \vspace*{-\baselineskip} 1209 | ```Haskell 1210 | [[1, 1, 1, 1, 1, 1, 1, 1, 1, 1], 1211 | [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 1212 | [1, 3, 6, 10, 15, 21, 28, 36, 45, 55], 1213 | [1, 4, 10, 20, 35, 56, 84, 120, 165, 220], 1214 | [1, 5, 15, 35, 70, 126, 210, 330, 495, 715], 1215 | [1, 6, 21, 56, 126, 252, 462, 792, 1287, 2002], 1216 | [1, 7, 28, 84, 210, 462, 924, 1716, 3003, 5005], 1217 | [1, 8, 36, 120, 330, 792, 1716, 3432, 6435, 11440], 1218 | [1, 9, 45, 165, 495, 1287, 3003, 6435, 12870, 24310], 1219 | [1, 10, 55, 220, 715, 2002, 5005, 11440, 24310, 48620]] 1220 | ``` 1221 | 1222 | # With great power comes code snippets for a tech talk 1223 | 1224 | ```Haskell 1225 | data Cell = X | O deriving ( Eq ) 1226 | 1227 | life :: ([Int],[Int]) -> [[Cell]] -> Sheet3 Cell 1228 | life ruleset seed = 1229 | evaluate $ insert [map (map const) seed] blank where 1230 | blank = sheet (const X) (repeat . tapeOf . tapeOf $ rule) 1231 | rule place = 1232 | case (neighbors place `elem`) `onBoth` ruleset of 1233 | (True,_) -> O 1234 | (_,True) -> cell inward place 1235 | _ -> X 1236 | neighbors = length . filter (O ==) . cells bordering 1237 | bordering = map (inward &) (diag ++ vert ++ horz) 1238 | diag = (&) <$> horizontals <*> verticals 1239 | vert = [above, below] 1240 | horz = map d2 [right, left] 1241 | 1242 | conway :: [[Cell]] -> Sheet3 Cell 1243 | conway = life ([3],[2,3]) 1244 | ``` 1245 | 1246 | # With great power comes code snippets for a tech talk 1247 | 1248 | ```Haskell 1249 | glider :: Sheet3 Cell 1250 | glider = conway [[X,X,O], 1251 | [O,X,O], 1252 | [X,O,O]] 1253 | ``` 1254 | 1255 | . . . 1256 | 1257 | ``` 1258 | > printLife glider 1259 | ``` 1260 | 1261 | . . . 1262 | 1263 | \vspace*{-\baselineskip} 1264 | \includegraphics[width=6em]{glider.png} 1265 | 1266 | # One more thing\dots 1267 | 1268 | ```Haskell 1269 | evaluate :: ComonadApply w 1270 | => w (w a -> a) -> w a 1271 | evaluate fs = 1272 | fix $ (fs <@>) . duplicate 1273 | ``` 1274 | 1275 | . . . 1276 | 1277 | ```Haskell 1278 | evaluateF :: (ComonadApply w, Functor f) 1279 | => w (f (w (f a) -> a)) -> w (f a) 1280 | evaluateF fs = 1281 | fix $ (<@> fs) . fmap (fmap . flip ($)) . duplicate 1282 | ``` 1283 | 1284 | # One more thing\dots 1285 | 1286 | \includegraphics[height=15em]{waterflow1.png} 1287 | 1288 | **Credit:** Chris Done: \url{chrisdone.com/posts/twitter-problem-loeb} 1289 | 1290 | # One more thing\dots 1291 | 1292 | \includegraphics[height=15em]{waterflow2.png} 1293 | 1294 | **Credit:** Chris Done: \url{chrisdone.com/posts/twitter-problem-loeb} 1295 | 1296 | # One more thing\dots 1297 | 1298 | Chris Done says: 1299 | 1300 | > I think if I'd've heard of [the comonadic fixed-point solution] before, this solution would’ve come to mind instead, it seems entirely natural! 1301 | 1302 | > Sadly, this is the slowest algorithm on the page. I’m not sure how to optimize it to be better. 1303 | 1304 | # One more thing\dots 1305 | 1306 | ```Haskell 1307 | waterflow :: [Integer] -> Integer 1308 | waterflow heights = 1309 | sum . zipWith subtract heights . map (foldr1 min) 1310 | . S.toList . view right 1311 | . evaluateF 1312 | . sheet ground . map maxima $ heights 1313 | 1314 | maxima :: Integer -> Pair (Sheet1 (Pair Integer) -> Integer) 1315 | maxima here = 1316 | Pair (max here . car . cell left) 1317 | (max here . cdr . cell right) 1318 | 1319 | ground :: Pair (Sheet1 (Pair Integer) -> Integer) 1320 | ground = Pair (const 0) (const 0) 1321 | 1322 | data Pair a = Pair { car :: a , cdr :: a } 1323 | instance Functor Pair ... 1324 | instance Applicative Pair ... 1325 | instance Foldable Pair ... 1326 | ``` 1327 | 1328 | # One more thing\dots 1329 | 1330 | \vspace*{1em} 1331 | \includegraphics[height=10em]{waterflow2.png} 1332 | 1333 | ``` 1334 | > waterflow [2,5,1,2,3,4,7,7,6] 1335 | 10 1336 | ``` 1337 | 1338 | . . . 1339 | 1340 | ```Haskell 1341 | main = 1342 | print =<< waterflow . take 10000 . map abs <$> getRandoms 1343 | ``` 1344 | 1345 | ``` 1346 | > time ./Waterflow 1347 | 46023422461957264691440 1348 | 0.12 real 0.11 user 0.01 sys 1349 | ``` 1350 | 1351 | # 1352 | 1353 | \vspace*{3\baselineskip} 1354 | 1355 | \begin{center} 1356 | \LARGE\texttt{cabal install ComonadSheet} 1357 | \vspace*{\baselineskip} 1358 | 1359 | \texttt{github.com/kwf/ComonadSheet} 1360 | 1361 | \Large Suggestions, bug reports, pull requests welcome! 1362 | \end{center} 1363 | -------------------------------------------------------------------------------- /Presentation/rainbow.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/plaidfinch/ComonadSheet/1cc9a91dc311bc1c692df4faaea091238b7871c2/Presentation/rainbow.jpg -------------------------------------------------------------------------------- /Presentation/shark-fin-ocean.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/plaidfinch/ComonadSheet/1cc9a91dc311bc1c692df4faaea091238b7871c2/Presentation/shark-fin-ocean.jpg -------------------------------------------------------------------------------- /Presentation/waterflow1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/plaidfinch/ComonadSheet/1cc9a91dc311bc1c692df4faaea091238b7871c2/Presentation/waterflow1.png -------------------------------------------------------------------------------- /Presentation/waterflow2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/plaidfinch/ComonadSheet/1cc9a91dc311bc1c692df4faaea091238b7871c2/Presentation/waterflow2.png -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ComonadSheet 2 | ============ 3 | 4 | A library for expressing "spreadsheet-like" computations with absolute and relative references, using fixed-points of n-dimensional comonads. A sheet is an n-dimensionally nested `Tape`, which is a stream infinite in both left and right directions, with a focus element. For instance, `type Sheet1 a = Nested (Flat Tape) a`, which is isomorphic to `Tape a`. Nested `Tape`s describe multi-dimensional grid-like spaces, which I will refer to, rather leadingly, as *sheets* made up of *cells*. 5 | 6 | While a conventional spreadsheet combines the construction and evaluation of a space of formulae into one process for the user, these steps are distinct in the `ComonadSheet` library. To create a self-referencing spreadsheet-like computation, first construct a multi-dimensional space of functions which take as input a *space of values* and return a *single value*. Then, take its fixed point using the `evaluate` function, resulting in a *space of values*. A type speaks more than a thousand words: 7 | 8 | ```Haskell 9 | evaluate :: (ComonadApply w) => w (w a -> a) -> w a 10 | ``` 11 | 12 | But if you want a thousand words, you can read the documentation (below and in the source), or listen to me talk: 13 | 14 | - ["Getting a Quick Fix on Comonads"](https://www.youtube.com/watch?v=F7F-BzOB670): invited talk at Boston Haskell, September 17, 2014. 15 | 16 | Installation 17 | ------------ 18 | 19 | ``` 20 | $ cabal update 21 | $ cabal install ComonadSheet 22 | ``` 23 | 24 | Creating Sheets 25 | --------------- 26 | 27 | Usually, the best way to create a sheet is using the `sheet` function, or using the `pure` method of the `Applicative` interface. The `sheet` function takes a default element value, and a structure containing more values, and inserts those values into a space initially filled with the default value. For instance, `sheet 0 [[1]] :: Sheet2 Int` makes a two-dimensional sheet which is 0 everywhere except the focus, which is 1. Note that because of overloading on `sheet`'s operands, it is usually necessary to give a type signature somewhere. This is generally not a problem because GHC can almost always infer the type you wanted if you give it so much as a top-level signature. 28 | 29 | References and Manipulation 30 | --------------------------- 31 | 32 | References to sheets are represented as quasi-heterogeneous lists of absolute and relative references. (In the `Names` module, I've provided names for referring to dimensions up to 4.) A reference which talks about some dimension *n* can be used to refer to that same relative or absolute location in any sheet of dimension *n* or greater. 33 | 34 | For instance, `rightBy 5` is a relative reference in the first dimension. If I let `x = sheet 0 [1..] :: Sheet1 Int`, then `extract (go (rightBy 5) x) == 6`. Notice that I used the `extract` method from the sheet's `Comonad` instance to pull out the focus element. Another way to express the same thing would be to say `cell (rightBy 5) x` -- the `cell` function is the composition of `extract` and `go`. In addition to moving around in sheets, I can use references to slice out pieces of them. For instance, `take (rightBy 5) x == [1,2,3,4,5,6]`. (Note that references used in extracting ranges are treated as inclusive.) I can also use a reference to point in a direction and extract an infinite stream (or stream- of-stream-of- streams...) pointed in that direction. For instance, `view right x == [1..]`. 35 | 36 | References can be relative or absolute. An absolute reference can only be used to refer to an `Indexed` sheet, as this is the only kind of sheet with a notion of absolute position. 37 | 38 | References can be combined using the `(&)` operator. For example, `columnAt 5 & aboveBy 10` represents a reference to a location above the current focus position by 10 cells, and at column 5, regardless of the current column position. Relative references may be combined with one another, and absolute and relative references may be combined, but combining two absolute references is a type error. 39 | 40 | Examples 41 | -------- 42 | 43 | The environment I'll be using as a demo-space looks like: 44 | ```Haskell 45 | import Control.Comonad.Sheet 46 | import Data.Stream ( Stream , repeat , (<:>) ) 47 | 48 | import Control.Applicative ( (<$>), (<*>) ) 49 | import Data.List ( intersperse ) 50 | import Data.Bool ( bool ) 51 | 52 | import qualified Prelude as P 53 | import Prelude hiding ( repeat , take ) 54 | ``` 55 | 56 | ### Iterated Numbers 57 | 58 | A one-dimensional sheet which is zero left of the origin and lists the natural numbers right of the origin: 59 | 60 | ```Haskell 61 | naturals :: Sheet1 Integer 62 | naturals = evaluate $ sheet 0 (repeat (cell left + 1)) 63 | ``` 64 | 65 | When we print this out... 66 | 67 | ```Haskell 68 | > take (rightBy 10) naturals 69 | [1,2,3,4,5,6,7,8,9,10,11] 70 | ``` 71 | 72 | ### Pascal's Triangle 73 | 74 | An infinite spreadsheet listing the rows of Pascal's triangle as upwards-rightwards diagonals: 75 | 76 | ```Haskell 77 | pascal :: Sheet2 Integer 78 | pascal = evaluate . sheet 0 $ 79 | repeat 1 <:> repeat (1 <:> pascalRow) 80 | where pascalRow = repeat $ cell above + cell left 81 | ``` 82 | 83 | Notice the fact that I'm using the `(+)` function to add *functions* (namely, `cell above` and `cell left`). This is thanks to some clever overloading from `Data.Numeric.Function`. 84 | 85 | This looks like: 86 | 87 | ```Haskell 88 | > take (belowBy 9 & rightBy 9) pascal 89 | [[1, 1, 1, 1, 1, 1, 1, 1, 1, 1], 90 | [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 91 | [1, 3, 6, 10, 15, 21, 28, 36, 45, 55], 92 | [1, 4, 10, 20, 35, 56, 84, 120, 165, 220], 93 | [1, 5, 15, 35, 70, 126, 210, 330, 495, 715], 94 | [1, 6, 21, 56, 126, 252, 462, 792, 1287, 2002], 95 | [1, 7, 28, 84, 210, 462, 924, 1716, 3003, 5005], 96 | [1, 8, 36, 120, 330, 792, 1716, 3432, 6435, 11440], 97 | [1, 9, 45, 165, 495, 1287, 3003, 6435, 12870, 24310], 98 | [1, 10, 55, 220, 715, 2002, 5005, 11440, 24310, 48620]] 99 | ``` 100 | 101 | We can also traverse it to find the rows of Pascal's triangle, by defining a function to diagonalize an infinite space: 102 | 103 | ```Haskell 104 | diagonalize :: Sheet2 a -> [[a]] 105 | diagonalize = 106 | zipWith P.take [1..] 107 | . map (map extract . P.iterate (go (above & right))) 108 | . P.iterate (go below) 109 | ``` 110 | 111 | On Pascal's triangle, this results in: 112 | 113 | ```Haskell 114 | > P.take 15 (diagonalize pascal) 115 | [[1], 116 | [1, 1], 117 | [1, 2, 1], 118 | [1, 3, 3, 1], 119 | [1, 4, 6, 4, 1], 120 | [1, 5, 10, 10, 5, 1], 121 | [1, 6, 15, 20, 15, 6, 1], 122 | [1, 7, 21, 35, 35, 21, 7, 1], 123 | [1, 8, 28, 56, 70, 56, 28, 8, 1], 124 | [1, 9, 36, 84, 126, 126, 84, 36, 9, 1], 125 | [1, 10, 45, 120, 210, 252, 210, 120, 45, 10, 1], 126 | [1, 11, 55, 165, 330, 462, 462, 330, 165, 55, 11, 1], 127 | [1, 12, 66, 220, 495, 792, 924, 792, 495, 220, 66, 12, 1], 128 | [1, 13, 78, 286, 715, 1287, 1716, 1716, 1287, 715, 286, 78, 13, 1], 129 | [1, 14, 91, 364, 1001, 2002, 3003, 3432, 3003, 2002, 1001, 364, 91, 14, 1]] 130 | ``` 131 | 132 | ### Fibonacci-like Sequences 133 | 134 | We can define a three-dimensional space enumerating all the Fibonacci-like sequences starting from positive seed numbers a and b, and subsequent terms equal to the sum of the two previous terms. (The normal Fibonacci sequence can be recovered with seeds a = 1, b = 1.) 135 | 136 | This example is thanks to an enlightening conversation with Eden Zik. 137 | 138 | ```Haskell 139 | fibLike :: Sheet3 Integer 140 | fibLike = evaluate $ sheet 0 $ 141 | fibSheetFrom 1 1 <:> repeat (fibSheetFrom (cell inward + 1) (cell inward)) 142 | where fibSheetFrom a b = (a <:> b <:> fibRow) <:> 143 | repeat (cell above <:> (1 + cell above) <:> fibRow) 144 | fibRow = repeat $ cell (leftBy 1) + cell (leftBy 2) 145 | ``` 146 | 147 | Examining a slice of this space, we find the following: 148 | 149 | ```Haskell 150 | > take (rightBy 4 & belowBy 4 & outwardBy 2) fibLike 151 | [[[1,1,2, 3, 5], -- the original Fibonacci sequence 152 | [1,2,3, 5, 8], 153 | [1,3,4, 7,11], 154 | [1,4,5, 9,14], 155 | [1,5,6,11,17]], 156 | [[2,1,3, 4, 7], 157 | [2,2,4, 6,10], -- double the Fibonacci sequence 158 | [2,3,5, 8,13], 159 | [2,4,6,10,16], 160 | [2,5,7,12,19]], 161 | [[3,1,4, 5, 9], -- a curious coincidence with the opening digits of pi 162 | [3,2,5, 7,12], 163 | [3,3,6, 9,15], -- triple the Fibonacci sequence 164 | [3,4,7,11,18], 165 | [3,5,8,13,21]]] 166 | ``` 167 | 168 | ### Conway's Game of Life 169 | 170 | Of course, as this is a comonadic library, we're obligated to implement the canonical nontrivial comonadic computation: Conway's Game of Life. 171 | 172 | For convenience, we define a few types: 173 | 174 | ```Haskell 175 | data Cell = X | O deriving ( Eq , Show ) 176 | type Universe = Sheet3 Cell 177 | type Ruleset = ([Int],[Int]) -- list of numbers of neighbors to trigger 178 | -- being born, and staying alive, respectively 179 | ``` 180 | 181 | Then we can define a function which takes a starting configuration (seed) for the Game of Life, and inserts it into the infinite universe of Game-of-Life cells. 182 | 183 | Here, we represent the evolution of an instance of the game of life as a three-dimensional space where two axes are space, and the third is time. 184 | 185 | In the Conway space, all cells before time zero are always dead cells, and all cells starting at time zero are equal to the Life rule applied to their neighboring cells in the previous time frame. To instantiate a timeline for a seed pattern, it is inserted as a series of constant cells into time frame zero of the blank Conway space. Then, the Conway space is evaluated, resulting in an infinite 3D space showing the evolution of the pattern. 186 | 187 | ```Haskell 188 | life :: Ruleset -> [[Cell]] -> Universe 189 | life ruleset seed = evaluate $ insert [map (map const) seed] blank 190 | where blank = sheet (const X) (repeat . tapeOf . tapeOf $ rule) 191 | rule place = case (neighbors place `elem`) `onBoth` ruleset of 192 | (True,_) -> O 193 | (_,True) -> cell inward place 194 | _ -> X 195 | neighbors = length . filter (O ==) . cells bordering 196 | bordering = map (inward &) (diagonals ++ verticals ++ horizontals) 197 | diagonals = (&) <$> horizontals <*> verticals 198 | verticals = [above, below] 199 | horizontals = map d2 [right, left] 200 | 201 | onBoth :: (a -> b) -> (a,a) -> (b,b) 202 | f `onBoth` (x,y) = (f x,f y) 203 | 204 | conway :: [[Cell]] -> Universe 205 | conway = life ([3],[2,3]) 206 | ``` 207 | 208 | For aesthetics, we can define a printer function for generations of the game of life. Note that the printer function is more or less as long as the definition of the real computation! 209 | 210 | ```Haskell 211 | printLife :: Int -> Int -> Int -> Universe -> IO () 212 | printLife c r t = mapM_ putStr 213 | . ([separator '┌' '─' '┐'] ++) 214 | . (++ [separator '└' '─' '┘']) 215 | . intersperse (separator '├' '─' '┤') 216 | . map (unlines . map (("│ " ++) . (++ " │")) . frame) 217 | . take (rightBy c & belowBy r & outwardBy t) 218 | where 219 | separator x y z = [x] ++ P.replicate (1 + (1 + c) * 2) y ++ [z] ++ "\n" 220 | frame = map $ intersperse ' ' . map (bool ' ' '●' . (O ==)) 221 | ``` 222 | 223 | Here's how we define a universe containing only a single glider: 224 | 225 | ```Haskell 226 | glider :: Universe 227 | glider = conway [[X,X,O], 228 | [O,X,O], 229 | [X,O,O]] 230 | ``` 231 | 232 | And it works! 233 | 234 | ``` 235 | > printLife 3 3 4 glider 236 | ┌─────────┐ 237 | │ ● │ 238 | │ ● ● │ 239 | │ ● ● │ 240 | │ │ 241 | ├─────────┤ 242 | │ ● │ 243 | │ ● ● │ 244 | │ ● ● │ 245 | │ │ 246 | ├─────────┤ 247 | │ ● │ 248 | │ ● │ 249 | │ ● ● ● │ 250 | │ │ 251 | ├─────────┤ 252 | │ │ 253 | │ ● ● │ 254 | │ ● ● │ 255 | │ ● │ 256 | ├─────────┤ 257 | │ │ 258 | │ ● │ 259 | │ ● ● │ 260 | │ ● ● │ 261 | └─────────┘ 262 | ``` 263 | 264 | Here's a Lightweight Spaceship: 265 | 266 | ```Haskell 267 | spaceship :: Universe 268 | spaceship = conway [[X,X,X,X,X], 269 | [X,O,O,O,O], 270 | [O,X,X,X,O], 271 | [X,X,X,X,O], 272 | [O,X,X,O,X]] 273 | ``` 274 | 275 | When we run it... 276 | 277 | ``` 278 | > printLife 6 4 4 spaceship 279 | ┌───────────────┐ 280 | │ │ 281 | │ ● ● ● ● │ 282 | │ ● ● │ 283 | │ ● │ 284 | │ ● ● │ 285 | ├───────────────┤ 286 | │ ● ● │ 287 | │ ● ● ● ● │ 288 | │ ● ● ● ● │ 289 | │ ● ● │ 290 | │ │ 291 | ├───────────────┤ 292 | │ ● ● │ 293 | │ ● │ 294 | │ ● ● │ 295 | │ ● ● ● ● │ 296 | │ │ 297 | ├───────────────┤ 298 | │ │ 299 | │ ● ● │ 300 | │ ● ● ● ● │ 301 | │ ● ● ● ● │ 302 | │ ● ● │ 303 | ├───────────────┤ 304 | │ │ 305 | │ ● ● ● ● │ 306 | │ ● ● │ 307 | │ ● │ 308 | │ ● ● │ 309 | └───────────────┘ 310 | ``` 311 | 312 | -------------------------------------------------------------------------------- /src/ComonadSheet.cabal: -------------------------------------------------------------------------------- 1 | name: ComonadSheet 2 | version: 0.3.0.0 3 | stability: experimental 4 | homepage: https://github.com/kwf/ComonadSheet 5 | synopsis: A library for expressing spreadsheet-like computations as the fixed-points of comonads. 6 | description: @ComonadSheet@ is a library for expressing spreadsheet-like computations with absolute and relative references, using fixed-points of n-dimensional comonads. For examples of use, see the for the library. 7 | license: BSD3 8 | license-file: LICENSE 9 | author: Kenneth Foner 10 | maintainer: kenneth.foner@gmail.com 11 | bug-reports: https://github.com/kwf/ComonadSheet/issues 12 | copyright: Copyright: (c) 2013-2014 Kenneth W. Foner 13 | category: Control 14 | build-type: Simple 15 | cabal-version: >=1.10 16 | 17 | library 18 | 19 | exposed-modules: 20 | Control.Comonad.Sheet.Indexed, 21 | Control.Comonad.Sheet.Names, 22 | Control.Comonad.Sheet.Reference, 23 | Control.Comonad.Sheet.Manipulate, 24 | Control.Comonad.Sheet.Examples, 25 | Control.Comonad.Sheet 26 | 27 | other-extensions: 28 | FlexibleContexts, 29 | FlexibleInstances, 30 | GADTs, 31 | MultiParamTypeClasses, 32 | UndecidableInstances, 33 | LambdaCase, 34 | RankNTypes, 35 | StandaloneDeriving, 36 | ConstraintKinds, 37 | DataKinds, 38 | ScopedTypeVariables, 39 | TypeFamilies, 40 | TypeOperators, 41 | PolyKinds, 42 | DeriveFunctor, 43 | TupleSections 44 | 45 | build-depends: 46 | base >=4.7 && < 4.8, 47 | comonad >=4.0, 48 | distributive >=0.1, 49 | transformers >=0.3, 50 | applicative-numbers >= 0.1.3, 51 | Stream >=0.4, 52 | NestedFunctor >= 0.2, 53 | PeanoWitnesses >= 0.1, 54 | IndexedList >= 0.1, 55 | Tape >= 0.4, 56 | containers >=0.5 57 | 58 | default-language: Haskell2010 59 | -------------------------------------------------------------------------------- /src/Control/Comonad/Sheet.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Control.Comonad.Sheet 3 | Description : A library for expressing "spreadsheet-like" computations with absolute and relative references, using fixed-points of n-dimensional comonads. 4 | Copyright : Copyright (c) 2014 Kenneth Foner 5 | 6 | Maintainer : kenneth.foner@gmail.com 7 | Stability : experimental 8 | Portability : non-portable 9 | 10 | @ComonadSheet@ is a library for expressing spreadsheet-like computations with absolute and relative references, using fixed-points of n-dimensional comonads. A sheet is an n-dimensionally nested 'Tape', which is a stream infinite in both left and right directions, with a focus element. For instance, @type Sheet1 a = Nested (Flat Tape) a@, which is isomorphic to @Tape a@. Nested @Tape@s describe multi-dimensional grid-like spaces, which I will refer to, rather leadingly, as /sheets/ made up of /cells/. 11 | 12 | While a conventional spreadsheet combines the construction and evaluation of a space of formulae into one process for the user, these steps are distinct in the @ComonadSheet@ library. To create a self-referencing spreadsheet-like computation, first construct a multi-dimensional space of functions which take as input a /space of values/ and return a /single value/. Then, take its fixed point using the @evaluate@ function, resulting in a /space of values/. In other words: 13 | 14 | > evaluate :: (ComonadApply w) => w (w a -> a) -> w a 15 | 16 | For examples of use, see the for the library. 17 | 18 | =Creating Sheets 19 | 20 | Usually, the best way to create a sheet is using the 'sheet' function, or using the 'pure' method of the 'Applicative' interface. The @sheet@ function takes a default element value, and a structure containing more values, and inserts those values into a space initially filled with the default value. For instance, @sheet 0 [[1]] :: Sheet2 Int@ makes a two- dimensional sheet which is 0 everywhere except the focus, which is 1. Note that because of overloading on @sheet@'s operands, it is usually necessary to give a type signature somewhere. This is generally not a problem because GHC can almost always infer the type you wanted if you give it so much as a top-level signature. 21 | 22 | =References and Manipulation 23 | 24 | References to sheets are represented as quasi-heterogeneous lists of absolute and relative references. (In the 'Names' module, I've provided names for referring to dimensions up to 4.) A reference which talks about some dimension /n/ can be used to refer to that same relative or absolute location in any sheet of dimension /n/ or greater. 25 | 26 | For instance, @rightBy 5@ is a relative reference in the first dimension. If I let @x = sheet 0 [1..] :: Sheet1 Int@, then @extract (go (rightBy 5) x) == 6@. Notice that I used the 'extract' method from the sheet's 'Comonad' instance to pull out the focus element. Another way to express the same thing would be to say @cell (rightBy 5) x@ -- the @cell@ function is the composition of 'extract' and 'go'. In addition to moving around in sheets, I can use references to slice out pieces of them. For instance, @take (rightBy 5) x == [1,2,3,4,5,6]@. (Note that references used in extracting ranges are treated as inclusive.) I can also use a reference to point in a direction and extract an infinite stream (or stream- of-stream-of- streams...) pointed in that direction. For instance, @view right x == [1..]@. 27 | 28 | References can be relative or absolute. An absolute reference can only be used to refer to an `Indexed` sheet, as this is the only kind of sheet with a notion of absolute position. 29 | 30 | References can be combined using the @(&)@ operator. For example, @columnAt 5 & aboveBy 10@ represents a reference to a location above the current focus position by 10 cells, and at column 5, regardless of the current column position. Relative references may be combined with one another, and absolute and relative references may be combined, but combining two absolute references is a type error. 31 | 32 | =A Simple Example 33 | 34 | A one-dimensional sheet which is zero left of the origin and lists the natural numbers right of the origin: 35 | 36 | > naturals :: Sheet3 Integer 37 | > naturals = evaluate $ sheet 0 (repeat (cell left + 1)) 38 | 39 | > take (rightBy 10) naturals == [1,2,3,4,5,6,7,8,9,10,11] 40 | 41 | For more examples, including Pascal's triangle, Fibonacci numbers, and Conway's Game of Life, see the for the library. 42 | -} 43 | 44 | {-# LANGUAGE FlexibleContexts #-} 45 | {-# LANGUAGE ConstraintKinds #-} 46 | {-# LANGUAGE TypeFamilies #-} 47 | 48 | module Control.Comonad.Sheet 49 | ( evaluate , evaluateF 50 | , cell , cells 51 | , sheet , indexedSheet , sheetFromNested 52 | -- Names for the relevant aspects of some smaller dimensions. 53 | , module Control.Comonad.Sheet.Names 54 | -- Generic functions for manipulating multi-dimensional comonadic spreadsheets. 55 | , module Control.Comonad.Sheet.Manipulate 56 | -- Adds absolute position to n-dimensional comonadic spreadsheets. 57 | , module Control.Comonad.Sheet.Indexed 58 | -- Relative and absolute references to locations in arbitrary-dimensional sheets. 59 | , module Control.Comonad.Sheet.Reference 60 | 61 | -- The 'Nested' type enables us to abstract over dimensionality. For instance, a 2-dimensional sheet of integers 62 | -- is represented by a @Nested (Nest (Flat Tape) Tape) Int@. 63 | , module Data.Functor.Nested 64 | -- Counted and conic lists, used for representing references. 65 | , module Data.List.Indexed 66 | -- The 'Tape' is the base type we use to construct sheets. A 'Tape' is a both-ways-infinite stream, like a Turing 67 | -- machine's tape. 68 | , module Data.Stream.Tape 69 | -- Peano numerals linked to type-level indices. 70 | , module Data.Numeric.Witness.Peano 71 | 72 | -- Comonads form the basis of sheet evaluation. 73 | , module Control.Comonad 74 | -- Distributivity enables composition of comonads. 75 | , module Data.Distributive 76 | -- Numeric instances for functions gives us, for functions @f, g :: Num b => a -> b@, e.g. 77 | -- @f + g == \x -> f x + g x@. This enables concise syntax for specifying numeric cells in sheets. 78 | , module Data.Numeric.Function 79 | ) where 80 | 81 | import Control.Comonad.Sheet.Names 82 | import Control.Comonad.Sheet.Manipulate 83 | import Control.Comonad.Sheet.Indexed 84 | import Control.Comonad.Sheet.Reference 85 | 86 | import Data.Functor.Nested 87 | import Data.List.Indexed 88 | import Data.Stream.Tape 89 | import Data.Numeric.Witness.Peano 90 | 91 | import Control.Comonad 92 | import Control.Applicative 93 | import Data.Distributive 94 | import Data.Traversable 95 | import Data.Numeric.Function 96 | import Data.Function 97 | 98 | -- "It is senseless to speak of the number of all objects." -- Ludwig Wittgenstein 99 | -- "No one will drive us from the paradise which Cantor created for us." -- David Hilbert 100 | 101 | -- | Take a container of functions referencing containers of values and return the fixed-point: a container of values. 102 | evaluate :: (ComonadApply w) => w (w a -> a) -> w a 103 | evaluate fs = fix $ (fs <@>) . duplicate 104 | 105 | evaluateF :: (ComonadApply w, Functor f) => w (f (w (f a) -> a)) -> w (f a) 106 | evaluateF fs = fix $ (<@> fs) . fmap (fmap . flip ($)) . duplicate 107 | 108 | -- evaluate in terms of evaluateF is: 109 | -- fmap runIdentity . evaluateF . fmap (Identity . (. fmap runIdentity)) 110 | 111 | -- | Given a relative or absolute position, extract from a sheet the value at that location. 112 | cell :: (Comonad w, Go r w) => RefList r -> w a -> a 113 | cell = (extract .) . go 114 | 115 | -- | Given a list of relative or absolute positions, extract from a sheet the values at those locations. 116 | cells :: (Traversable t, Comonad w, Go r w) => t (RefList r) -> w a -> t a 117 | cells = traverse cell 118 | 119 | -- | Given a default value and an insertable container of values, construct a sheet containing those values. 120 | sheet :: ( InsertNested l (Nested ts) , Applicative (Nested ts) 121 | , DimensionalAs x (Nested ts a) , AsDimensionalAs x (Nested ts a) ~ l a ) 122 | => a -> x -> Nested ts a 123 | sheet background list = insert list (pure background) 124 | 125 | change :: (InsertNested l w, ComonadApply w, 126 | DimensionalAs x (w (w a -> a)), 127 | AsDimensionalAs x (w (w a -> a)) ~ l (w a -> a)) 128 | => x -> w a -> w a 129 | change new old = evaluate $ insert new (fmap const old) 130 | 131 | sheetFromNested :: ( InsertNested (Nested fs) (Nested (NestedNTimes (NestedCount fs) Tape)) 132 | , Applicative (Nested (NestedNTimes (NestedCount fs) Tape)) ) 133 | => a -> Nested fs a -> Nested (NestedNTimes (NestedCount fs) Tape) a 134 | sheetFromNested background list = insertNested list (pure background) 135 | 136 | -- | Given an origin index, a default value, and an insertable container of values, construct an indexed sheet. 137 | indexedSheet :: ( InsertNested l (Nested ts) , Applicative (Nested ts) 138 | , DimensionalAs x (Nested ts a) , AsDimensionalAs x (Nested ts a) ~ l a) 139 | => Coordinate (NestedCount ts) -> a -> x -> Indexed ts a 140 | indexedSheet i = (Indexed i .) . sheet 141 | -------------------------------------------------------------------------------- /src/Control/Comonad/Sheet/Examples.hs: -------------------------------------------------------------------------------- 1 | module Control.Comonad.Sheet.Examples where 2 | 3 | import Control.Comonad.Sheet 4 | 5 | import Control.Applicative ( (<$>), (<*>) ) 6 | import Data.List ( intersperse ) 7 | import Data.Bool ( bool ) 8 | 9 | import Data.Stream ( Stream , repeat , (<:>) ) 10 | 11 | import qualified Prelude as P 12 | import Prelude hiding ( repeat , take ) 13 | 14 | pascal :: Sheet2 Integer 15 | pascal = evaluate . sheet 0 $ 16 | repeat 1 <:> repeat (1 <:> pascalRow) 17 | where pascalRow = repeat $ cell above + cell left 18 | 19 | diagonalize :: Sheet2 a -> [[a]] 20 | diagonalize = 21 | zipWith P.take [1..] 22 | . map (map extract . P.iterate (go (above & right))) 23 | . P.iterate (go below) 24 | 25 | fibLike :: Sheet3 Integer 26 | fibLike = evaluate $ sheet 0 $ 27 | fibSheetFrom 1 1 <:> repeat (fibSheetFrom (cell inward + 1) (cell inward)) 28 | where fibSheetFrom a b = (a <:> b <:> fibRow) <:> 29 | repeat (cell above <:> (1 + cell above) <:> fibRow) 30 | fibRow = repeat $ cell (leftBy 1) + cell (leftBy 2) 31 | 32 | data Cell = X | O deriving ( Eq , Show ) 33 | type Universe = Sheet3 Cell 34 | type Ruleset = ([Int],[Int]) -- list of numbers of neighbors to trigger 35 | -- being born, and staying alive, respectively 36 | 37 | life :: Ruleset -> [[Cell]] -> Universe 38 | life ruleset seed = evaluate $ insert [map (map const) seed] blank 39 | where blank = sheet (const X) (repeat . tapeOf . tapeOf $ rule) 40 | rule place = case (neighbors place `elem`) `onBoth` ruleset of 41 | (True,_) -> O 42 | (_,True) -> cell inward place 43 | _ -> X 44 | neighbors = length . filter (O ==) . cells bordering 45 | bordering = map (inward &) (diagonals ++ verticals ++ horizontals) 46 | diagonals = (&) <$> horizontals <*> verticals 47 | verticals = [above, below] 48 | horizontals = map d2 [right, left] 49 | 50 | onBoth :: (a -> b) -> (a,a) -> (b,b) 51 | f `onBoth` (x,y) = (f x,f y) 52 | 53 | conway :: [[Cell]] -> Universe 54 | conway = life ([3],[2,3]) 55 | 56 | printLife :: Int -> Int -> Int -> Universe -> IO () 57 | printLife c r t = mapM_ putStr 58 | . ([separator '┌' '─' '┐'] ++) 59 | . (++ [separator '└' '─' '┘']) 60 | . intersperse (separator '├' '─' '┤') 61 | . map (unlines . map (("│ " ++) . (++ " │")) . frame) 62 | . take (rightBy c & belowBy r & outwardBy t) 63 | where 64 | separator x y z = [x] ++ P.replicate (1 + (1 + c) * 2) y ++ [z] ++ "\n" 65 | frame = map $ intersperse ' ' . map (bool ' ' '●' . (O ==)) 66 | 67 | glider :: Universe 68 | glider = conway [[X,X,O], 69 | [O,X,O], 70 | [X,O,O]] 71 | 72 | spaceship :: Universe 73 | spaceship = conway [[X,X,X,X,X], 74 | [X,O,O,O,O], 75 | [O,X,X,X,O], 76 | [X,X,X,X,O], 77 | [O,X,X,O,X]] 78 | -------------------------------------------------------------------------------- /src/Control/Comonad/Sheet/Indexed.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Control.Comonad.Sheet.Indexed 3 | Description : Adds absolute position to n-dimensional comonadic spreadsheets. 4 | Copyright : Copyright (c) 2014 Kenneth Foner 5 | 6 | Maintainer : kenneth.foner@gmail.com 7 | Stability : experimental 8 | Portability : non-portable 9 | 10 | This module defines the @Indexed@ type, which bolts an absolute coordinate onto a normal nested structure, allowing 11 | you to talk about absolute position as well as relative position. 12 | -} 13 | 14 | {-# LANGUAGE ConstraintKinds #-} 15 | {-# LANGUAGE DataKinds #-} 16 | {-# LANGUAGE FlexibleContexts #-} 17 | {-# LANGUAGE TypeFamilies #-} 18 | {-# LANGUAGE PolyKinds #-} 19 | {-# LANGUAGE MultiParamTypeClasses #-} 20 | {-# LANGUAGE FlexibleInstances #-} 21 | {-# LANGUAGE UndecidableInstances #-} 22 | 23 | module Control.Comonad.Sheet.Indexed where 24 | 25 | import Control.Comonad 26 | import Control.Applicative 27 | import Data.Functor.Identity 28 | import Data.Functor.Compose 29 | 30 | import Data.Numeric.Witness.Peano 31 | import Data.Stream.Tape 32 | import Control.Comonad.Sheet.Reference 33 | import Data.Functor.Nested 34 | import Data.List.Indexed 35 | 36 | -- | An n-dimensional coordinate is a list of length n of absolute references. 37 | type Coordinate n = CountedList n (Ref Absolute) 38 | 39 | -- | An indexed sheet is an n-dimensionally nested 'Tape' paired with an n-dimensional coordinate which 40 | -- represents the absolute position of the current focus in the sheet. 41 | data Indexed ts a = 42 | Indexed { index :: Coordinate (NestedCount ts) 43 | , unindexed :: Nested ts a } 44 | 45 | instance (Functor (Nested ts)) => Functor (Indexed ts) where 46 | fmap f (Indexed i t) = Indexed i (fmap f t) 47 | 48 | -- | For a sheet to be Indexable, it needs to consist of n-dimensionally nested 'Tape's, such that we can take the 49 | -- cross product of all n tapes to generate a tape of indices. 50 | type Indexable ts = ( Cross (NestedCount ts) Tape , ts ~ NestedNTimes (NestedCount ts) Tape ) 51 | 52 | instance (ComonadApply (Nested ts), Indexable ts) => Comonad (Indexed ts) where 53 | extract = extract . unindexed 54 | duplicate it = Indexed (index it) $ 55 | Indexed <$> indices (index it) 56 | <@> duplicate (unindexed it) 57 | 58 | instance (ComonadApply (Nested ts), Indexable ts) => ComonadApply (Indexed ts) where 59 | (Indexed i fs) <@> (Indexed _ xs) = Indexed i (fs <@> xs) 60 | 61 | -- | Takes an n-coordinate and generates an n-dimensional enumerated space of coordinates. 62 | indices :: (Cross n Tape) => Coordinate n -> Nested (NestedNTimes n Tape) (Coordinate n) 63 | indices = cross . fmap enumerate 64 | 65 | -- | The cross product of an n-length counted list of @(t a)@ is an n-nested @t@ of counted lists of @a@. 66 | class Cross n t where 67 | cross :: CountedList n (t a) -> Nested (NestedNTimes n t) (CountedList n a) 68 | 69 | instance (Functor t) => Cross (Succ Zero) t where 70 | cross (t ::: _) = 71 | Flat $ (::: CountedNil) <$> t 72 | 73 | instance ( Cross (Succ n) t , Functor t 74 | , Functor (Nested (NestedNTimes (Succ n) t)) ) 75 | => Cross (Succ (Succ n)) t where 76 | cross (t ::: ts) = 77 | Nest $ (\xs -> (::: xs) <$> t) <$> cross ts 78 | -------------------------------------------------------------------------------- /src/Control/Comonad/Sheet/Manipulate.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Control.Comonad.Sheet.Manipulate 3 | Description : Generic functions for manipulating multi-dimensional comonadic spreadsheets. 4 | Copyright : Copyright (c) 2014 Kenneth Foner 5 | 6 | Maintainer : kenneth.foner@gmail.com 7 | Stability : experimental 8 | Portability : non-portable 9 | 10 | This module defines the 'take', 'view', 'go', and 'insert' functions generically for any dimensionality of sheet. These 11 | constitute the preferred way of manipulating sheets, providing an interface to: take finite slices ('take'), infinite 12 | slices ('view'), move to locations ('go'), and insert finite or infinite structures ('insert'). 13 | -} 14 | 15 | {-# LANGUAGE DataKinds #-} 16 | {-# LANGUAGE FlexibleContexts #-} 17 | {-# LANGUAGE FlexibleInstances #-} 18 | {-# LANGUAGE MultiParamTypeClasses #-} 19 | {-# LANGUAGE TypeFamilies #-} 20 | {-# LANGUAGE TypeOperators #-} 21 | {-# LANGUAGE UndecidableInstances #-} 22 | 23 | module Control.Comonad.Sheet.Manipulate where 24 | 25 | import Data.Stream.Tape 26 | import Control.Comonad.Sheet.Indexed 27 | import Data.Numeric.Witness.Peano 28 | import Data.Functor.Nested 29 | import Control.Comonad.Sheet.Reference 30 | import Data.List.Indexed hiding ( replicate ) 31 | 32 | import Data.Stream ( Stream(..) , (<:>) ) 33 | import qualified Data.Stream as S 34 | 35 | import Control.Applicative 36 | import Prelude hiding ( take ) 37 | 38 | class Take r t where 39 | -- | The type of an n-dimensional list extracted from an n-dimensional sheet. For instance: 40 | -- 41 | -- > ListFrom Sheet2 a == [[a]] 42 | type ListFrom t a 43 | -- | Given a 'RefList' and an n-dimensional sheet, return an n-dimensional list corresponding to taking items from 44 | -- the space until reaching the (relative or absolute) coordinates specified. 45 | take :: RefList r -> t a -> ListFrom t a 46 | 47 | class View r t where 48 | -- | The type of an n-dimensional stream extracted from an n-dimensional sheet. For instance: 49 | -- 50 | -- > StreamFrom Sheet2 a == Stream (Stream a) 51 | type StreamFrom t a 52 | -- | Given a 'RefList' and an n-dimensional sheet, return an n-dimensional stream corresponding to the "view" in the 53 | -- direction specified by the sign of each of the coordinates. The direction implied by an absolute coordinate is 54 | -- the direction from the current focus to that location. 55 | view :: RefList r -> t a -> StreamFrom t a 56 | 57 | class Go r t where 58 | -- | Given a 'RefList' and an n-dimensional sheet, move to the location specified by the @RefList@ given. 59 | go :: RefList r -> t a -> t a 60 | 61 | -- | Combination of 'go' and 'take': moves to the location specified by the first argument, then takes the amount 62 | -- specified by the second argument. 63 | slice :: (Take r' t, Go r t) => RefList r -> RefList r' -> t a -> ListFrom t a 64 | slice r r' = take r' . go r 65 | 66 | -- | Use this to insert a (possibly nested) list-like structure into a (possibly many-dimensional) sheet. 67 | -- Note that the depth of nesting of the structure being inserted must match the number of dimensions of the sheet 68 | -- into which it is being inserted. Note also that the structure being inserted need not be a @Nested@ type; it 69 | -- need only have enough levels of structure (i.e. number of nested lists) to match the dimensionality of the sheet. 70 | insert :: (DimensionalAs x (t a), InsertNested l t, AsDimensionalAs x (t a) ~ l a) => x -> t a -> t a 71 | insert l t = insertNested (l `asDimensionalAs` t) t 72 | 73 | -- | Take (n + 1) things from a 'Tape', either in the rightward or leftward directions, depending on the sign of the 74 | -- reference given. If the reference is @(Rel 0)@, return the empty list. 75 | tapeTake :: Ref Relative -> Tape a -> [a] 76 | tapeTake (Rel r) t | r > 0 = focus t : S.take r (viewR t) 77 | tapeTake (Rel r) t | r < 0 = focus t : S.take (abs r) (viewL t) 78 | tapeTake _ _ = [] 79 | 80 | instance Take Nil (Nested (Flat Tape)) where 81 | type ListFrom (Nested (Flat Tape)) a = [a] 82 | take _ _ = [] 83 | 84 | instance (Take Nil (Nested ts), Functor (Nested ts)) => Take Nil (Nested (Nest ts Tape)) where 85 | type ListFrom (Nested (Nest ts Tape)) a = ListFrom (Nested ts) [a] 86 | take _ = take (Rel 0 :-: ConicNil) 87 | 88 | instance Take (Relative :-: Nil) (Nested (Flat Tape)) where 89 | type ListFrom (Nested (Flat Tape)) a = [a] 90 | take (r :-: _) (Flat t) = tapeTake r t 91 | 92 | instance ( Functor (Nested ts), Take rs (Nested ts) ) 93 | => Take (Relative :-: rs) (Nested (Nest ts Tape)) where 94 | type ListFrom (Nested (Nest ts Tape)) a = ListFrom (Nested ts) [a] 95 | take (r :-: rs) (Nest t) = take rs . fmap (tapeTake r) $ t 96 | 97 | instance ( Take (Replicate (NestedCount ts) Relative) (Nested ts) 98 | , Length r <= NestedCount ts 99 | , ((NestedCount ts - Length r) + Length r) ~ NestedCount ts 100 | ) => Take r (Indexed ts) where 101 | type ListFrom (Indexed ts) a = ListFrom (Nested ts) a 102 | take r (Indexed i t) = take (heterogenize id (getMovement r i)) t 103 | 104 | -- | Given a relative reference, either return the rightward-pointing stream or the leftward one, depending on the 105 | -- sign of the reference. @(Rel 0)@ defaults to rightward. 106 | tapeView :: Ref Relative -> Tape a -> Stream a 107 | tapeView (Rel r) t | r >= 0 = focus t <:> viewR t 108 | tapeView (Rel r) t | otherwise = focus t <:> viewL t 109 | 110 | instance View Nil (Nested (Flat Tape)) where 111 | type StreamFrom (Nested (Flat Tape)) a = Stream a 112 | view _ (Flat t) = tapeView (Rel 0) t 113 | 114 | instance (View Nil (Nested ts), Functor (Nested ts)) => View Nil (Nested (Nest ts Tape)) where 115 | type StreamFrom (Nested (Nest ts Tape)) a = StreamFrom (Nested ts) (Stream a) 116 | view _ = view (Rel 0 :-: ConicNil) 117 | 118 | instance View (Relative :-: Nil) (Nested (Flat Tape)) where 119 | type StreamFrom (Nested (Flat Tape)) a = (Stream a) 120 | view (r :-: _) (Flat t) = tapeView r t 121 | 122 | instance ( Functor (Nested ts), View rs (Nested ts) ) 123 | => View (Relative :-: rs) (Nested (Nest ts Tape)) where 124 | type StreamFrom (Nested (Nest ts Tape)) a = StreamFrom (Nested ts) (Stream a) 125 | view (r :-: rs) (Nest t) = view rs . fmap (tapeView r) $ t 126 | 127 | instance ( View (Replicate (NestedCount ts) Relative) (Nested ts) 128 | , Length r <= NestedCount ts 129 | , ((NestedCount ts - Length r) + Length r) ~ NestedCount ts 130 | ) => View r (Indexed ts) where 131 | type StreamFrom (Indexed ts) a = StreamFrom (Nested ts) a 132 | view r (Indexed i t) = view (heterogenize id (getMovement r i)) t 133 | 134 | -- | Given a relative reference, move that much in a 'Tape', either rightward or leftward depending on sign. 135 | tapeGo :: Ref Relative -> Tape a -> Tape a 136 | tapeGo (Rel r) = fpow (abs r) (if r > 0 then moveR else moveL) 137 | where fpow n = foldr (.) id . replicate n -- iterate a function n times 138 | 139 | instance Go (Relative :-: Nil) (Nested (Flat Tape)) where 140 | go (r :-: _) (Flat t) = Flat $ tapeGo r t 141 | 142 | instance Go Nil (Nested ts) where go _ = id 143 | 144 | instance (Go rs (Nested ts), Functor (Nested ts)) => Go (Relative :-: rs) (Nested (Nest ts Tape)) where 145 | go (r :-: rs) (Nest t) = Nest . go rs . fmap (tapeGo r) $ t 146 | 147 | instance ( Go (Replicate (NestedCount ts) Relative) (Nested ts) 148 | , Length r <= NestedCount ts 149 | , ((NestedCount ts - Length r) + Length r) ~ NestedCount ts 150 | , ReifyNatural (NestedCount ts) ) 151 | => Go r (Indexed ts) where 152 | go r (Indexed i t) = 153 | let move = getMovement r i 154 | in Indexed (merge move i) (go (heterogenize id move) t) 155 | 156 | -- | A @(Signed f a)@ is an @(f a)@ annotated with a sign: either @Positive@ or @Negative@. This is a useful type for 157 | -- specifying the directionality of insertions into sheets. By wrapping a list or stream in a @Negative@ and then 158 | -- inserting it into a sheet, you insert it in the opposite direction to the usual one: leftward, upward, inward... 159 | data Signed f a = Positive (f a) 160 | | Negative (f a) 161 | deriving ( Eq , Ord , Show ) 162 | 163 | -- | In order to insert an n-dimensional list-like structure @(l a)@ into an n-dimensional @Tape@, it's only necessary 164 | -- to define how to insert a 1-dimensional @(l a)@ into a 1-dimensional @Tape@. Add instances of this class if you 165 | -- want to be able to insert custom types into a sheet. 166 | class InsertBase l where 167 | insertBase :: l a -> Tape a -> Tape a 168 | 169 | -- | Inserting a @Tape@ into another @Tape@ replaces the latter with the former completely. 170 | instance InsertBase Tape where 171 | insertBase t _ = t 172 | 173 | -- | Inserting a @Stream@ into a @Tape@ replaces the focus and right side of the @Tape@ with the contents of the stream. 174 | instance InsertBase Stream where 175 | insertBase (Cons x xs) (Tape ls _ _) = Tape ls x xs 176 | 177 | -- | Inserting a @Signed Stream@ into a @Tape@ either behaves just like inserting a regular @Stream@, or (in the @Negative@ case) inserts the stream to the left. 178 | instance InsertBase (Signed Stream) where 179 | insertBase (Positive (Cons x xs)) (Tape ls _ _) = Tape ls x xs 180 | insertBase (Negative (Cons x xs)) (Tape _ _ rs) = Tape xs x rs 181 | 182 | -- | Inserting a list into a @Tape@ prepends the contents of the list rightwards in the @Tape@, pushing the old focus 183 | -- element rightward (i.e. the head of the list becomes the new focus). 184 | instance InsertBase [] where 185 | insertBase [] t = t 186 | insertBase (x : xs) (Tape ls c rs) = 187 | Tape ls x (S.prefix xs (Cons c rs)) 188 | 189 | -- | Inserting a @Signed []@ into a @Tape@ either behaves just like inserting a regular list, or (in the @Negative@ case) inserts the list to the left. 190 | instance InsertBase (Signed []) where 191 | insertBase (Positive []) t = t 192 | insertBase (Negative []) t = t 193 | insertBase (Positive (x : xs)) (Tape ls c rs) = 194 | Tape ls x (S.prefix xs (Cons c rs)) 195 | insertBase (Negative (x : xs)) (Tape ls c rs) = 196 | Tape (S.prefix xs (Cons c ls)) x rs 197 | 198 | -- | This typeclass is the inductive definition for inserting things into higher-dimensional spaces. To make new types 199 | -- insertable, add instances of 'InsertBase', not @InsertNested@. 200 | class InsertNested l t where 201 | insertNested :: l a -> t a -> t a 202 | 203 | instance (InsertBase l) => InsertNested (Nested (Flat l)) (Nested (Flat Tape)) where 204 | insertNested (Flat l) (Flat t) = Flat $ insertBase l t 205 | 206 | instance ( InsertBase l , InsertNested (Nested ls) (Nested ts) 207 | , Functor (Nested ls) , Applicative (Nested ts) ) 208 | => InsertNested (Nested (Nest ls l)) (Nested (Nest ts Tape)) where 209 | insertNested (Nest l) (Nest t) = 210 | Nest $ insertNested (insertBase <$> l) (pure id) <*> t 211 | 212 | instance (InsertNested l (Nested ts)) => InsertNested l (Indexed ts) where 213 | insertNested l (Indexed i t) = Indexed i (insertNested l t) 214 | 215 | -- | @DimensionalAs@ provides a mechanism to "lift" an n-deep nested structure into an explicit @Nested@ type. This 216 | -- is the way in which raw lists-of-lists-of-lists, etc. can be inserted (without manual annotation of nesting depth) 217 | -- into a sheet. 218 | class DimensionalAs x y where 219 | type AsDimensionalAs x y 220 | -- | @x `asDimensionalAs` y@ applies the appropriate constructors for 'Nested' to @x@ a number of times equal to 221 | -- the number of dimensions of @y@. For instance: 222 | -- 223 | -- > [['x']] `asDimensionalAs` Nest (Flat [['y']]) == Nest (Flat [['x']]) 224 | asDimensionalAs :: x -> y -> x `AsDimensionalAs` y 225 | 226 | -- | In the case of a @Nested@ structure, @asDimensionalAs@ defaults to @asNestedAs@. 227 | instance (NestedAs x (Nested ts y), AsDimensionalAs x (Nested ts y) ~ AsNestedAs x (Nested ts y)) => DimensionalAs x (Nested ts y) where 228 | type x `AsDimensionalAs` (Nested ts a) = x `AsNestedAs` (Nested ts a) 229 | asDimensionalAs = asNestedAs 230 | 231 | -- | @DimensionalAs@ also knows the dimensionality of an 'Indexed' sheet as well as regular @Nested@ structures. 232 | instance (NestedAs x (Nested ts y)) => DimensionalAs x (Indexed ts y) where 233 | type x `AsDimensionalAs` (Indexed ts a) = x `AsNestedAs` (Nested ts a) 234 | x `asDimensionalAs` (Indexed i t) = x `asNestedAs` t 235 | -------------------------------------------------------------------------------- /src/Control/Comonad/Sheet/Names.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Control.Comonad.Sheet.Names 3 | Description : Names for the relevant aspects of some smaller dimensions (currently up to 4). 4 | Copyright : Copyright (c) 2014 Kenneth Foner 5 | 6 | Maintainer : kenneth.foner@gmail.com 7 | Stability : experimental 8 | Portability : non-portable 9 | 10 | This module defines names to be used manipulating n-dimensional sheets. Currently, names are defined for dimensions 11 | of 4 and fewer. Below is a summary of the names currently defined in this module. Template Haskell to define these names for new dimension numbers is coming soon! 12 | 13 | =Dimension 1: 14 | 15 | * 'Sheet1' is the type of a 1-dimensional sheet 16 | 17 | * 'left' (negative) and 'right' (positive) are directions 18 | 19 | * 'leftBy' and 'rightBy' define relative position by some integer argument 20 | 21 | * 'columnAt' defines absolute position at a given column 22 | 23 | * 'column' retrieves the current column index 24 | 25 | * 'd1' coerces a 1-or-fewer-dimensional reference to a 1-dimensional reference 26 | 27 | =Dimension 2: 28 | 29 | * 'Sheet2' is the type of a 2-dimensional sheet 30 | 31 | * 'above' (negative) and 'below' (positive) are directions 32 | 33 | * 'aboveBy' and 'belowBy' define relative position by some integer argument 34 | 35 | * 'rowAt' defines absolute position at a given row 36 | 37 | * 'row' retrieves the current row index 38 | 39 | * 'd2' coerces a 2-or-fewer-dimensional reference to a 2-dimensional reference 40 | 41 | =Dimension 3: 42 | 43 | * 'Sheet3' is the type of a 3-dimensional sheet 44 | 45 | * 'inward' (negative) and 'outward' (positive) are directions 46 | 47 | * 'inwardBy' and 'outwardBy' define relative position by some integer argument 48 | 49 | * 'levelAt' defines absolute position at a given level 50 | 51 | * 'level' retrieves the current level index 52 | 53 | * 'd3' coerces a 3-or-fewer-dimensional reference to a 3-dimensional reference 54 | 55 | =Dimension 4: 56 | 57 | * 'Sheet4' is the type of a 4-dimensional sheet 58 | 59 | * 'ana' (negative) and 'kata' (positive) are directions 60 | 61 | * 'anaBy' and 'kataBy' define relative position by some integer argument 62 | 63 | * 'spaceAt' defines absolute position at a given space 64 | 65 | * 'space' retrieves the current space index 66 | 67 | * 'd4' coerces a 4-or-fewer-dimensional reference to a 4-dimensional reference 68 | 69 | -} 70 | 71 | {-# LANGUAGE DataKinds #-} 72 | {-# LANGUAGE FlexibleContexts #-} 73 | {-# LANGUAGE TypeFamilies #-} 74 | {-# LANGUAGE TypeOperators #-} 75 | 76 | module Control.Comonad.Sheet.Names 77 | ( Sheet1 , here1 , d1 , columnAt , column , rightBy , leftBy , right , left 78 | , Sheet2 , here2 , d2 , rowAt , row , aboveBy , belowBy , above , below 79 | , Sheet3 , here3 , d3 , levelAt , level , inwardBy , outwardBy , inward , outward 80 | , Sheet4 , here4 , d4 , spaceAt , space , anaBy , kataBy , ana , kata 81 | ) where 82 | 83 | import Control.Comonad.Sheet.Reference 84 | import Data.Numeric.Witness.Peano 85 | import Data.Stream.Tape 86 | import Control.Comonad.Sheet.Indexed 87 | import Data.Functor.Nested 88 | import Data.List.Indexed 89 | 90 | -- One dimension... 91 | 92 | type Rel1 = Relative :-: Nil 93 | type Nat1 = Succ Zero 94 | 95 | nat1 :: Natural Nat1 96 | nat1 = reifyNatural 97 | 98 | type Sheet1 = Nested (NestedNTimes Nat1 Tape) 99 | type ISheet1 = Indexed (NestedNTimes Nat1 Tape) 100 | 101 | here1 :: RefList Rel1 102 | here1 = Rel 0 :-: ConicNil 103 | 104 | d1 :: (CombineRefLists Rel1 x) => RefList x -> RefList (Rel1 & x) 105 | d1 = (here1 &) 106 | 107 | columnAt :: Int -> RefList (Absolute :-: Nil) 108 | columnAt = dimensional nat1 . Abs 109 | 110 | column :: (Zero < NestedCount ts) => Indexed ts x -> Int 111 | column = getRef . nth Zero . index 112 | 113 | rightBy, leftBy :: Int -> RefList Rel1 114 | rightBy = dimensional nat1 . Rel 115 | leftBy = rightBy . negate 116 | 117 | right, left :: RefList Rel1 118 | right = rightBy 1 119 | left = leftBy 1 120 | 121 | -- Two dimensions... 122 | 123 | type Rel2 = Relative :-: Rel1 124 | type Nat2 = Succ Nat1 125 | 126 | nat2 :: Natural Nat2 127 | nat2 = reifyNatural 128 | 129 | type Sheet2 = Nested (NestedNTimes Nat2 Tape) 130 | type ISheet2 = Indexed (NestedNTimes Nat2 Tape) 131 | 132 | here2 :: RefList Rel2 133 | here2 = Rel 0 :-: here1 134 | 135 | d2 :: (CombineRefLists Rel2 x) => RefList x -> RefList (Rel2 & x) 136 | d2 = (here2 &) 137 | 138 | rowAt :: Int -> RefList (Tack Absolute Rel1) 139 | rowAt = dimensional nat2 . Abs 140 | 141 | row :: (Nat1 < NestedCount ts) => Indexed ts x -> Int 142 | row = getRef . nth nat1 . index 143 | 144 | belowBy, aboveBy :: Int -> RefList Rel2 145 | belowBy = dimensional nat2 . Rel 146 | aboveBy = belowBy . negate 147 | 148 | below, above :: RefList Rel2 149 | below = belowBy 1 150 | above = aboveBy 1 151 | 152 | -- Three dimensions... 153 | 154 | type Rel3 = Relative :-: Rel2 155 | type Nat3 = Succ Nat2 156 | 157 | nat3 :: Natural Nat3 158 | nat3 = reifyNatural 159 | 160 | type Sheet3 = Nested (NestedNTimes Nat3 Tape) 161 | type ISheet3 = Indexed (NestedNTimes Nat3 Tape) 162 | 163 | here3 :: RefList Rel3 164 | here3 = Rel 0 :-: here2 165 | 166 | d3 :: (CombineRefLists Rel3 x) => RefList x -> RefList (Rel3 & x) 167 | d3 = (here3 &) 168 | 169 | levelAt :: Int -> RefList (Tack Absolute Rel2) 170 | levelAt = dimensional nat3 . Abs 171 | 172 | level :: (Nat2 < NestedCount ts) => Indexed ts x -> Int 173 | level = getRef . nth nat2 . index 174 | 175 | outwardBy, inwardBy :: Int -> RefList Rel3 176 | outwardBy = dimensional nat3 . Rel 177 | inwardBy = outwardBy . negate 178 | 179 | outward, inward :: RefList Rel3 180 | outward = outwardBy 1 181 | inward = inwardBy 1 182 | 183 | -- Four dimensions... 184 | 185 | type Rel4 = Relative :-: Rel3 186 | type Nat4 = Succ Nat3 187 | 188 | nat4 :: Natural Nat4 189 | nat4 = reifyNatural 190 | 191 | type Sheet4 = Nested (NestedNTimes Nat4 Tape) 192 | type ISheet4 = Indexed (NestedNTimes Nat4 Tape) 193 | 194 | here4 :: RefList Rel4 195 | here4 = Rel 0 :-: here3 196 | 197 | d4 :: (CombineRefLists Rel4 x) => RefList x -> RefList (Rel4 & x) 198 | d4 = (here4 &) 199 | 200 | spaceAt :: Int -> RefList (Tack Absolute Rel3) 201 | spaceAt = dimensional nat4 . Abs 202 | 203 | space :: (Nat3 < NestedCount ts) => Indexed ts x -> Int 204 | space = getRef . nth nat3 . index 205 | 206 | anaBy, kataBy :: Int -> RefList Rel4 207 | anaBy = dimensional nat4 . Rel 208 | kataBy = anaBy . negate 209 | 210 | ana, kata :: RefList Rel4 211 | ana = anaBy 1 212 | kata = kataBy 1 213 | -------------------------------------------------------------------------------- /src/Control/Comonad/Sheet/Reference.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Control.Comonad.Sheet.Reference 3 | Description : Relative and absolute references to locations in arbitrary-dimensional sheets. 4 | Copyright : Copyright (c) 2014 Kenneth Foner 5 | 6 | Maintainer : kenneth.foner@gmail.com 7 | Stability : experimental 8 | Portability : non-portable 9 | 10 | This module defines the types needed to construct and manipulate references to locations in n-dimensional sheets. 11 | All sheets support relative references, but only 'Indexed' sheets support absolute references; the type system prevents 12 | the use of absolute references for sheets without an index. 13 | -} 14 | 15 | {-# LANGUAGE DataKinds #-} 16 | {-# LANGUAGE FlexibleContexts #-} 17 | {-# LANGUAGE FlexibleInstances #-} 18 | {-# LANGUAGE GADTs #-} 19 | {-# LANGUAGE MultiParamTypeClasses #-} 20 | {-# LANGUAGE PolyKinds #-} 21 | {-# LANGUAGE RankNTypes #-} 22 | {-# LANGUAGE StandaloneDeriving #-} 23 | {-# LANGUAGE TypeFamilies #-} 24 | {-# LANGUAGE TypeOperators #-} 25 | 26 | module Control.Comonad.Sheet.Reference where 27 | 28 | import Data.Numeric.Witness.Peano 29 | import Data.List.Indexed 30 | 31 | import Control.Applicative 32 | import Data.List ( intercalate ) 33 | 34 | import Prelude hiding ( replicate , length ) 35 | 36 | -- | A 'Ref' is either absolute or relative. This type exists solely to be lifted to the type/kind level. 37 | data RefType = Relative | Absolute 38 | 39 | -- | A @Ref@ is either absolute or relative. Either holds an @Int@, but their semantics differ. 40 | data Ref (t :: RefType) where 41 | Rel :: Int -> Ref Relative 42 | Abs :: Int -> Ref Absolute 43 | deriving instance Show (Ref t) 44 | 45 | -- | Extract the raw @Int@ from a @Ref@. Use this sparingly, as every time you do, you risk accidentally converting 46 | -- to the other variety of @Ref@ if you're not careful. 47 | getRef :: Ref t -> Int 48 | getRef (Abs x) = x 49 | getRef (Rel x) = x 50 | 51 | instance Enum (Ref Relative) where 52 | fromEnum (Rel r) = r 53 | toEnum = Rel 54 | 55 | instance Enum (Ref Absolute) where 56 | fromEnum (Abs r) = r 57 | toEnum = Abs 58 | 59 | -- | Two absolute references cannot be combined into a single reference, but relative and absolute references can be 60 | -- combined to form an absolute reference, and two relative references can be combined into one relative reference. 61 | type family Combine a b where 62 | Combine Relative Absolute = Absolute 63 | Combine Absolute Relative = Absolute 64 | Combine Relative Relative = Relative 65 | 66 | -- | Combine @Ref@s which can be meaningfully combined. Note the absence of the absolute-absolute case; there's no 67 | -- good meaning for combining two absolute references, so it is statically prohibited. 68 | class CombineRefs a b where 69 | combine :: Ref a -> Ref b -> Ref (Combine a b) 70 | instance CombineRefs Absolute Relative where 71 | combine (Abs a) (Rel b) = Abs (a + b) 72 | instance CombineRefs Relative Absolute where 73 | combine (Rel a) (Abs b) = Abs (a + b) 74 | instance CombineRefs Relative Relative where 75 | combine (Rel a) (Rel b) = Rel (a + b) 76 | 77 | -- | A @RefList@ is a list of @Ref@s, each of which may be individually relative or absolute. 78 | type RefList = ConicList Ref 79 | 80 | infixr 4 & 81 | type family a & b where 82 | (a :-: as) & (b :-: bs) = Combine a b :-: (as & bs) 83 | Nil & bs = bs 84 | as & Nil = as 85 | 86 | -- | We can combine lists of references if their corresponding elements can be combined. When combining two lists of 87 | -- references, any trailing elements from the longer list will be preserved at the end; this is /unlike/ the behavior 88 | -- of, e.g., @zip@. 89 | class CombineRefLists as bs where 90 | (&) :: RefList as -> RefList bs -> RefList (as & bs) 91 | instance (CombineRefs a b, CombineRefLists as bs) 92 | => CombineRefLists (a :-: as) (b :-: bs) where (a :-: as) & (b :-: bs) = combine a b :-: (as & bs) 93 | instance CombineRefLists Nil (b :-: bs) where ConicNil & bs = bs 94 | instance CombineRefLists (a :-: as) Nil where as & ConicNil = as 95 | instance CombineRefLists Nil Nil where ConicNil & ConicNil = ConicNil 96 | 97 | -- | Given a homogeneous list of length n containing relative references, we can merge those relative positions with a 98 | -- homogeneous list of absolute references. This yields another list of absolute references. 99 | merge :: (ReifyNatural n) 100 | => CountedList n (Ref Relative) 101 | -> CountedList n (Ref Absolute) 102 | -> CountedList n (Ref Absolute) 103 | merge rs as = (\(Rel r) (Abs a) -> Abs (r + a)) <$> rs <*> as 104 | 105 | -- | Finds the relative movement necessary to move from a given absolute coordinate to the location specified by a 106 | -- list of relative and absolute coordinates. 107 | diff :: CountedList n (Either (Ref Relative) (Ref Absolute)) 108 | -> CountedList n (Ref Absolute) 109 | -> CountedList n (Ref Relative) 110 | diff (Left (Rel r) ::: rs) (Abs i ::: is) = Rel r ::: diff rs is 111 | diff (Right (Abs r) ::: rs) (Abs i ::: is) = Rel (r - i) ::: diff rs is 112 | diff CountedNil _ = CountedNil 113 | diff _ CountedNil = CountedNil 114 | 115 | -- | Given a list of relative and absolute references (an n-dimensional reference) and an n-dimensional coordinate, 116 | -- we can obtain the relative movement necessary to get from the coordinate to the location specified by the 117 | -- references given. 118 | getMovement :: (Length ts <= n, ((n - Length ts) + Length ts) ~ n) 119 | => RefList ts -> CountedList n (Ref Absolute) -> CountedList n (Ref Relative) 120 | getMovement refs coords = 121 | padTo (count coords) (Left (Rel 0)) (homogenize eitherFromRef refs) `diff` coords 122 | 123 | -- | Given a @Ref@, forget the type-level information about whether it's absolute or relative by casting it into an 124 | -- @Either@ type where the @Left@ branch holds a relative reference or the @Right@ holds an absolute one. 125 | eitherFromRef :: Ref t -> Either (Ref Relative) (Ref Absolute) 126 | eitherFromRef (Rel r) = Left (Rel r) 127 | eitherFromRef (Abs a) = Right (Abs a) 128 | 129 | -- | Given a number /n/ greater than zero and some reference, prepend (n - 1) relative references of value zero to the 130 | -- reference given, thus creating an n-dimensional reference where the original reference refers to the nth dimension. 131 | dimensional :: Natural (Succ n) -> Ref t -> RefList (Tack t (Replicate n Relative)) 132 | dimensional (Succ n) a = tack a (heterogenize id (replicate n (Rel 0))) 133 | 134 | instance Show (RefList ts) where 135 | showsPrec p xs = showParen (p > 10) $ 136 | (showString $ ( intercalate " :-: " 137 | $ map (either show show) 138 | $ unCount 139 | $ homogenize eitherFromRef xs ) ++ " :-: ConicNil") 140 | -------------------------------------------------------------------------------- /src/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2014, Kenneth Foner 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Kenneth Foner nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /src/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | --------------------------------------------------------------------------------