├── AtomicState.hs ├── AtomicStateAlt.hs ├── Count.hs ├── ExtensibleState.hs ├── GradedMonad.hs ├── GradedState.hs ├── ParameterisedMonad.hs ├── README.md ├── SafeFiles.hs ├── Security.hs ├── State.hs ├── TypeLevelMaps.hs ├── UnsafeFiles.hs ├── foo ├── intro.hs ├── slides-chalmers.pdf └── slides.pdf /AtomicState.hs: -------------------------------------------------------------------------------- 1 | -- For clarity in type classes instances 2 | {-# LANGUAGE InstanceSigs #-} 3 | 4 | -- We're not in Kansas anymore... 5 | {-# LANGUAGE RebindableSyntax #-} 6 | 7 | module AtomicState where 8 | 9 | -- Bye Monads... as we know them 10 | import Prelude hiding (Monad(..)) 11 | -- Hello parameterised monads 12 | import ParameterisedMonad 13 | import State 14 | 15 | newtype Closed s = Closed s deriving Show 16 | newtype Open s = Open s deriving Show 17 | 18 | -- get :: State s s 19 | get :: State (Closed s) (Open s) s 20 | get = State $ \(Closed s) -> (s, Open s) 21 | 22 | -- put :: s -> State s () 23 | put :: t -> State (Open s) (Closed t) () 24 | put tx = State $ \(Open _) -> ((), Closed tx) 25 | 26 | -- modify :: (t -> t) -> State s () 27 | modify :: (s -> t) -> State (Closed s) (Closed t) () 28 | modify f = get >>= (put . f) 29 | 30 | ----------------------------- 31 | -- Examples 32 | 33 | myProgram :: State (Closed Int) (Closed Int) String 34 | myProgram = do 35 | x <- get 36 | put (x+1) 37 | a <- somethingPurish x 38 | return (a ++ show x) 39 | 40 | somethingPurish :: Int -> State (Closed Int) (Closed Int) String 41 | somethingPurish n = do 42 | x <- get 43 | put (x + 1) 44 | return $ if n == 0 then "hello" else "goodbye" 45 | -------------------------------------------------------------------------------- /AtomicStateAlt.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} 2 | -- For clarity in type classes instances 3 | {-# LANGUAGE InstanceSigs #-} 4 | 5 | -- We're not in Kansas anymore... 6 | {-# LANGUAGE RebindableSyntax #-} 7 | 8 | module AtomicStateAlt where 9 | 10 | -- Bye Monads... as we know them 11 | import Prelude hiding (Monad(..)) 12 | -- Hello parameterised monads 13 | import ParameterisedMonad 14 | import State 15 | 16 | newtype Closed s = Closed s deriving Show 17 | newtype Open s = Open s deriving Show 18 | 19 | class Getable t s where 20 | -- get :: State s s 21 | get :: State t (Open s) s 22 | 23 | instance Getable (Closed s) s where 24 | get = State $ \(Closed s) -> (s, Open s) 25 | 26 | instance Getable (Open s) s where 27 | get = State $ \(Open s) -> (s, Open s) 28 | 29 | -- put :: s -> State s () 30 | put :: t -> State (Open s) (Closed t) () 31 | put tx = State $ \(Open _) -> ((), Closed tx) 32 | 33 | -- modify :: (t -> t) -> State s () 34 | modify :: (s -> t) -> State (Closed s) (Closed t) () 35 | modify f = get >>= (put . f) 36 | 37 | ----------------------------- 38 | -- Examples 39 | 40 | myProgram :: State (Closed Int) (Closed Int) String 41 | myProgram = do 42 | x <- get 43 | put (x+1) 44 | a <- somethingPurish x 45 | return (a ++ show x) 46 | 47 | somethingPurish :: Int -> State (Closed Int) (Closed Int) String 48 | somethingPurish n = do 49 | x <- get 50 | put (x + 1) 51 | return $ if n == 0 then "hello" else "goodbye" 52 | -------------------------------------------------------------------------------- /Count.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeFamilies #-} 2 | {-# LANGUAGE EmptyDataDecls #-} 3 | {-# LANGUAGE TypeOperators #-} 4 | {-# LANGUAGE GADTs #-} 5 | {-# LANGUAGE UndecidableInstances #-} 6 | {-# LANGUAGE RebindableSyntax #-} 7 | 8 | module Count where 9 | 10 | {-| Provides a way to 'count' in the type-level with a monadic interface 11 | to sum up the individual counts of subcomputations -} 12 | -- See https://github.com/dorchard/effect-monad 13 | 14 | import Prelude hiding (Monad(..), map) 15 | import GradedMonad 16 | 17 | {-| Define type constructors for natural numbers -} 18 | data Z 19 | data S n 20 | 21 | {-| The counter has no semantic meaning -} 22 | newtype Counter n a = Counter { forget :: a } 23 | 24 | {-| Type-level addition -} 25 | type family n :+ m where 26 | n :+ Z = n -- n + 0 = n 27 | n :+ S m = S (n :+ m) -- n + (m + 1) = 1 + (n + m) 28 | 29 | instance GMonad Counter where 30 | 31 | {-| Trivial effect annotation is 0 -} 32 | type Zero Counter = Z 33 | {-| Compose effects by addition -} 34 | type Plus Counter n m = n :+ m 35 | 36 | -- return :: a -> Counter Z a 37 | return = Counter 38 | 39 | -- (>>=) :: Counter n a -> (a -> Counter m b) -> Counter (n :+ m) b 40 | (Counter a) >>= k = Counter . forget $ k a 41 | 42 | {-| A 'tick' provides a way to increment the counter -} 43 | tick :: Counter (S Z) () 44 | tick = Counter () 45 | 46 | -- TODO: tick tick 47 | example :: Int -> Counter (S (S Z)) Int 48 | example x = do 49 | tick 50 | tick 51 | return (2*x) 52 | 53 | -- Gets very cool when combined with sized types 54 | data Vector n a where 55 | Nil :: Vector Z a 56 | Cons :: a -> Vector n a -> Vector (S n) a 57 | 58 | 59 | vmap :: (a -> Counter t b) -> Vector n a -> Counter (n :* t) (Vector n b) 60 | vmap _ Nil = return Nil 61 | vmap f (Cons x xs) = do 62 | y <- f x 63 | ys <- vmap f xs 64 | return $ Cons y ys 65 | 66 | type family n :* m where 67 | Z :* m = Z 68 | S n :* m = m :+ (n :* m) 69 | 70 | inputList :: Vector (S (S (S Z))) Int 71 | inputList = Cons 1 (Cons 2 (Cons 3 Nil)) 72 | example2 = vmap example inputList 73 | -------------------------------------------------------------------------------- /ExtensibleState.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RebindableSyntax #-} 2 | {-# LANGUAGE DataKinds #-} 3 | {-# LANGUAGE GADTs #-} 4 | {-# LANGUAGE TypeOperators #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE FlexibleInstances #-} 7 | {-# LANGUAGE UndecidableInstances #-} 8 | {-# LANGUAGE TypeApplications #-} 9 | {-# LANGUAGE IncoherentInstances #-} 10 | {-# LANGUAGE ScopedTypeVariables #-} 11 | {-# LANGUAGE FlexibleContexts #-} 12 | {-# LANGUAGE ConstraintKinds #-} 13 | 14 | module ExtensibleState where 15 | 16 | -- Bye Monads... as we know them 17 | import Prelude hiding (Monad(..)) 18 | 19 | import ParameterisedMonad 20 | import State 21 | -- A local subset of the 'type-level-sets' package 22 | -- import Data.Type.Map 23 | import TypeLevelMaps 24 | 25 | 26 | -- Example map 27 | exMap :: Map '["x" ':-> Int, "flag" ':-> Bool] 28 | exMap = 29 | Ext (Var @ "x") (42 :: Int) 30 | $ Ext (Var @ "flag") False 31 | $ Empty 32 | 33 | 34 | 35 | 36 | -- Fine-grained get, put, and modify 37 | get :: IsMember v t m => Var v -> State (Map m) (Map m) t 38 | get v = State $ \s -> (lookp v s, s) 39 | 40 | 41 | 42 | 43 | put :: Updatable v t m n => Var v -> t -> State (Map m) (Map n) () 44 | put v t = State $ \s -> ((), update s v t) 45 | 46 | modify :: (IsMember v s m, Updatable v t m n) => Var v -> (s -> t) -> State (Map m) (Map n) () 47 | modify v f = do 48 | x <- get v 49 | put v (f x) 50 | 51 | 52 | -- Aliases for our operations 53 | type Get v t m = IsMember v t m 54 | type Put v t m n = Updatable v t m n 55 | type Update v t m = (Get v t m, Put v t m m) 56 | 57 | -- Examples 58 | 59 | increment :: (Update "x" Int m) => State (Map m) (Map m) () 60 | increment = do 61 | (n :: Int) <- get (Var @ "x") 62 | put (Var @ "x") (n+1) 63 | 64 | example = do 65 | flag <- get (Var @ "flag") 66 | increment 67 | (n :: Int) <- get (Var @"x") 68 | put (Var @ "flag") ((n > 0) || flag) 69 | 70 | 71 | go :: ((), Map '["x" ':-> Int, "flag" ':-> Bool]) 72 | go = runState example exMap 73 | 74 | example2 :: (Get "flag" Bool m, Update "x" Int m, Put "y" Int m m) => State (Map m) (Map m) () 75 | example2 = do 76 | flag <- get (Var @ "flag") 77 | if flag 78 | then modify (Var @ "x") (\(x :: Int) -> x + 1) 79 | else put (Var @ "y") (42 :: Int) 80 | -------------------------------------------------------------------------------- /GradedMonad.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeFamilies #-} 2 | {-# LANGUAGE PolyKinds #-} 3 | {-# LANGUAGE KindSignatures #-} 4 | {-# LANGUAGE MultiParamTypeClasses #-} 5 | {-# LANGUAGE FlexibleInstances #-} 6 | {-# LANGUAGE UndecidableInstances #-} 7 | 8 | module GradedMonad ((>>), GMonad(..), fail, ifThenElse) where 9 | 10 | -- Bye Monads... as we know them 11 | import Prelude hiding (Monad(..)) 12 | 13 | -- Defined in Control.Monad.Effetct (effect-monad package) 14 | -- https://github.com/dorchard/effect-monad 15 | class GMonad (g :: k -> * -> *) where 16 | type Zero g :: k 17 | type Plus g (x :: k) (y :: k) :: k 18 | 19 | return :: a -> g (Zero g) a 20 | (>>=) :: g x a -> (a -> g y b) -> g (Plus g x y) b 21 | 22 | 23 | -- Some boilerplate 24 | (>>) :: GMonad g => g x a -> g y b -> g (Plus g x y) b 25 | x >> y = x >>= const y 26 | 27 | fail :: String -> g x a 28 | fail = error 29 | 30 | -- More interesting types can be given here for graded monads, 31 | -- see https://github.com/dorchard/effect-monad 32 | -- Use the simple definition here 33 | ifThenElse :: Bool -> a -> a -> a 34 | ifThenElse True x _ = x 35 | ifThenElse False _ y = y 36 | -------------------------------------------------------------------------------- /GradedState.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE RebindableSyntax #-} 3 | {-# LANGUAGE TypeOperators #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | {-# LANGUAGE TypeApplications #-} 6 | 7 | import Prelude hiding (Monad(..)) 8 | import Control.Effect 9 | import ParameterisedMonad (ifThenElse) 10 | import Control.Effect.State 11 | 12 | example0 = do 13 | a <- get (Var @ "x") 14 | put (Var @ "x") (a+1) 15 | b <- get (Var @ "flag") 16 | return $ if b then a else 0 17 | 18 | x_var = Var @ "x" 19 | y_var = Var @ "y" 20 | 21 | {- Computation with a read effect on variable "x" and a 22 | read-write (update) effect on variable "y" -} 23 | 24 | example :: State '["x" :-> Int :! R, "y" :-> [Int] :! RW] [Int] 25 | example = do 26 | x <- get x_var 27 | y <- get y_var 28 | put y_var (x:y) 29 | z <- get y_var 30 | return (x:z) 31 | 32 | initS = Ext (x_var :-> (1 :! Eff)) (Ext (y_var :-> ([2,3] :! Eff)) Empty) 33 | example_run = runState example initS 34 | 35 | --example2 :: State '["x" :-> Int :! RW] Int 36 | example2 = do 37 | x <- get (Var::(Var "x")) 38 | put (Var::(Var "x")) (x+1) 39 | return x 40 | 41 | example2_run = (runState example2) (Ext (x_var :-> 10 :! Eff) Empty) 42 | 43 | example3 :: State '["x" :-> String :! RW] () 44 | example3 = do 45 | x <- get x_var 46 | put x_var (x ++ " ok !") 47 | -------------------------------------------------------------------------------- /ParameterisedMonad.hs: -------------------------------------------------------------------------------- 1 | -- Used to make the types extra clear 2 | {-# LANGUAGE KindSignatures #-} 3 | {-# LANGUAGE PolyKinds #-} 4 | 5 | -- This module implement parameterised monads due to Bob Atkey 6 | -- (see 'Parameterised Notions of Computing' JFP 2009) 7 | -- also defined in Control.Monad.Indexed (category-extras) 8 | 9 | module ParameterisedMonad ((>>), PMonad(..), fail, ifThenElse) where 10 | 11 | 12 | -- Bye bye Monads... as we know them 13 | import Prelude hiding (Monad(..)) 14 | 15 | 16 | -- Hello Parameterised Monads 17 | class PMonad (pm :: k -> k -> * -> *) where 18 | -- Lift pure values into effect-invariant computations 19 | return :: a -> pm inv inv a 20 | 21 | -- Sequentially compose effectful computations 22 | (>>=) :: pm pre interm t -> (t -> pm interm post t') -> pm pre post t' 23 | 24 | 25 | 26 | 27 | 28 | 29 | -- Other boilerplate 30 | (>>) :: PMonad pm => pm pre mid t -> pm mid post t' -> pm pre post t' 31 | x >> y = x >>= const y 32 | 33 | fail :: String -> m inv inv a 34 | fail = error 35 | 36 | ifThenElse :: Bool -> a -> a -> a 37 | ifThenElse True x _ = x 38 | ifThenElse False _ y = y 39 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Programs that explain their effects 2 | 3 | Material from a talk given at: 4 | * Chalmers Functional Programming Group, Gothenburgh, 2nd March 2018. 5 | * London Haskell User Group talk, 24th January 2018. 6 | * HaskellX Bytes (SkillsMatter), London, 9th November 2017. 7 | 8 | The examples here are supposed to be self contaiend, but can be rewritten in terms of the libraries: 9 | * Control.Monad.Effect (https://hackage.haskell.org/package/effect-monad) 10 | * Data.Type.Map (https://hackage.haskell.org/package/type-level-sets) 11 | 12 | The ideas in this talk are contained in various papers, the most pertinent being: 13 | * Embedding effect systems in Haskell (Orchard, Petricek 2014) 14 | (https://www.cs.kent.ac.uk/people/staff/dao7/publ/haskell14-effects.pdf) 15 | * Parameterised notions of computation (Atkey 2006, 2009) 16 | (https://strathprints.strath.ac.uk/34572/1/paramnotions_jfp.pdf) 17 | -------------------------------------------------------------------------------- /SafeFiles.hs: -------------------------------------------------------------------------------- 1 | 2 | {-# LANGUAGE RebindableSyntax #-} 3 | {-# LANGUAGE TypeOperators #-} 4 | {-# LANGUAGE KindSignatures #-} 5 | {-# LANGUAGE DataKinds #-} 6 | {-# LANGUAGE EmptyDataDecls #-} 7 | {-# LANGUAGE TypeFamilies #-} 8 | {-# LANGUAGE MultiParamTypeClasses #-} 9 | {-# LANGUAGE FlexibleInstances #-} 10 | {-# LANGUAGE FlexibleContexts #-} 11 | 12 | module SafeFiles where 13 | 14 | -- Bye Monads... as we know them 15 | import Prelude hiding (Monad(..)) 16 | import ParameterisedMonad 17 | 18 | -- Import qualified versions of standard code we want to wrap 19 | import qualified Prelude as P 20 | import qualified System.IO as IO 21 | 22 | import GHC.TypeLits -- gives us type-level natural numbers 23 | 24 | {- 25 | 26 | -- openFile :: FilePath -> IOMode -> IO Handle 27 | -- hGetChar :: Handle -> IO Char 28 | -- hPutChar :: Handle -> Char -> IO () 29 | -- hClose :: Handle -> IO () 30 | 31 | -- hIsOpen :: Handle -> IO Bool 32 | -- hIsClosed :: Handle -> IO Bool 33 | 34 | -} 35 | 36 | -- Wrap the IO monad 37 | newtype SafeFiles pre post a = SafeFiles { unSafeFiles :: IO a } 38 | 39 | -- Just use the IO monad underneath... 40 | instance PMonad SafeFiles where 41 | -- return :: a -> SafeFiles p p a 42 | return = SafeFiles . P.return 43 | -- (>>=) :: SafeFiles p q a -> (a -> SafeFiles q r b) -> SafeFiles p r b 44 | (SafeFiles m) >>= k = SafeFiles (m P.>>= (unSafeFiles . k)) 45 | 46 | ------------------------------------------------------------------ 47 | 48 | -- Safe handlers are indexed by a (unique) number 49 | newtype SafeHandle (n :: Nat) = 50 | SafeHandle { unsafeHandle :: IO.Handle } 51 | 52 | -- Protocol states are a pair of a 53 | -- * a type-level nat representing the next fresh handle 54 | -- * list of open handles 55 | data St (n :: Nat) (opens :: [Nat]) 56 | 57 | -- openFile :: FilePath -> IOMode -> IO Handle 58 | -- Opens a file, returns a handler with a fresh name 59 | openFile :: 60 | IO.FilePath 61 | -> IO.IOMode 62 | -> SafeFiles (St h opens) (St (h + 1) (h ': opens)) (SafeHandle h) 63 | openFile f mode = SafeFiles $ fmap SafeHandle (IO.openFile f mode) 64 | 65 | 66 | 67 | 68 | 69 | 70 | -- Membership predicate 71 | class Member (x :: Nat) (xs :: [Nat]) where 72 | instance {-# OVERLAPS #-} Member x (x ': xs) where 73 | instance {-# OVERLAPPABLE #-} Member x xs => Member x (y ': xs) 74 | 75 | -- hGetChar :: Handle -> IO Char 76 | hGetChar :: Member h opens => 77 | SafeHandle h 78 | -> SafeFiles (St n opens) (St n opens) Char 79 | 80 | 81 | 82 | hGetChar = SafeFiles . IO.hGetChar . unsafeHandle 83 | 84 | -- hPutChar :: Handle -> Char -> IO () 85 | hPutChar :: Member h opens => 86 | SafeHandle h 87 | -> Char -> SafeFiles (St n opens) (St n opens) () 88 | 89 | hPutChar (SafeHandle h) = SafeFiles . IO.hPutChar h 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | -- hClose :: Handle -> IO () 98 | hClose :: Member h opens => 99 | SafeHandle h 100 | -> SafeFiles (St n opens) (St n (Delete h opens)) () 101 | hClose = SafeFiles . IO.hClose . unsafeHandle 102 | 103 | -- Delete a handler name from a list 104 | type family Delete (n :: Nat) (ns :: [Nat]) where 105 | Delete n '[] = '[] 106 | Delete n (n ': ns) = ns 107 | Delete n (m ': ns) = m ': Delete n ns 108 | 109 | -- hIsEOF :: Handler -> IO Bool 110 | hIsEOF :: Member h opens => 111 | SafeHandle h -> SafeFiles (St n opens) (St n opens) Bool 112 | hIsEOF (SafeHandle h) = SafeFiles (IO.hIsEOF h) 113 | 114 | -- Only allow running when every file is closed at the end 115 | runSafeFiles :: SafeFiles (St 0 '[]) (St n '[]) a -> IO a 116 | runSafeFiles = unSafeFiles 117 | 118 | 119 | example = do 120 | h <- openFile "foo" IO.ReadWriteMode 121 | h' <- openFile "bar" IO.ReadWriteMode 122 | loopy h h' 123 | 124 | loopy h1 h2 = do 125 | isEmpty <- hIsEOF h1 126 | if isEmpty 127 | then do 128 | hClose h1 129 | hClose h2 130 | else do 131 | x <- hGetChar h1 132 | hPutChar h2 x 133 | loopy h1 h2 134 | -------------------------------------------------------------------------------- /Security.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE TypeFamilies #-} 3 | {-# LANGUAGE InstanceSigs #-} 4 | {-# LANGUAGE RebindableSyntax #-} 5 | 6 | import GradedMonad 7 | import Prelude hiding (Monad(..)) 8 | 9 | data Lattice = Public | Private 10 | -- where Public <= Private 11 | 12 | data Level (l :: Lattice) a = Level { unwrap :: a } 13 | deriving Show 14 | 15 | type family Join (l :: Lattice) (l' :: Lattice) :: Lattice where 16 | Join Private x = Private 17 | Join x Private = Private 18 | Join Public Public = Public 19 | 20 | instance GMonad Level where 21 | type Zero Level = Public 22 | type Plus Level l l' = Join l l' 23 | 24 | return :: a -> Level Public a 25 | return x = Level x 26 | 27 | (>>=) :: Level l a -> (a -> Level l' b) -> Level (Join l l') b 28 | (Level x) >>= k = let (Level y) = k x in Level y 29 | 30 | upcast :: Level Public a -> Level Private a 31 | upcast (Level x) = Level x 32 | 33 | run :: Level Public a -> a 34 | run = unwrap 35 | 36 | -------------------------------------------------------- 37 | 38 | secretPin :: Level Private Int 39 | secretPin = upcast (return 12345) 40 | 41 | hash :: Int -> Level Public Int 42 | hash x = return (x * x * x) 43 | 44 | salt = do 45 | pin <- secretPin 46 | h <- hash pin 47 | return (h + 1234) -------------------------------------------------------------------------------- /State.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE InstanceSigs #-} 2 | module State where 3 | 4 | -- Bye Monads... as we know them 5 | import Prelude hiding (Monad(..)) 6 | import ParameterisedMonad 7 | 8 | newtype State s1 s2 a = State { runState :: s1 -> (a, s2) } 9 | 10 | -- State parameterised monad 11 | -- ... with implementations just like the state monad 12 | instance PMonad State where 13 | return :: a -> State s s a 14 | return x = State (\s -> (x, s)) 15 | 16 | (>>=) :: State s1 s2 a -> (a -> State s2 s3 b) -> State s1 s3 b 17 | (State m) >>= k = 18 | State $ \s0 -> let (a, s1) = m s0 19 | State m' = k a in m' s1 20 | -------------------------------------------------------------------------------- /TypeLevelMaps.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE KindSignatures #-} 3 | {-# LANGUAGE GADTs #-} 4 | {-# LANGUAGE TypeOperators #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE FlexibleInstances #-} 7 | {-# LANGUAGE UndecidableInstances #-} 8 | {-# LANGUAGE IncoherentInstances #-} 9 | {-# LANGUAGE ScopedTypeVariables #-} 10 | {-# LANGUAGE FlexibleContexts #-} 11 | {-# LANGUAGE ConstraintKinds #-} 12 | {-# LANGUAGE PolyKinds #-} 13 | {-# LANGUAGE TypeFamilies #-} 14 | 15 | -- Taken from the `type-level-sets` package 16 | -- Data.Type.Map 17 | -- https://github.com/dorchard/type-level-sets 18 | -- https://hackage.haskell.org/package/type-level-sets 19 | module TypeLevelMaps where 20 | 21 | import GHC.TypeLits 22 | 23 | type family (:++) (x :: [k]) (y :: [k]) :: [k] where 24 | '[] :++ xs = xs 25 | (x ': xs) :++ ys = x ': (xs :++ ys) 26 | 27 | data Var (v :: Symbol) = Var 28 | 29 | instance KnownSymbol v => Show (Var v) where 30 | show = symbolVal 31 | 32 | -- Mappings 33 | infixr 9 :-> 34 | {-| A key-value pair -} 35 | data Mapping k v = k :-> v 36 | 37 | data Map (n :: [Mapping Symbol *]) where 38 | Empty :: Map '[] 39 | Ext :: Var v -> t -> Map m -> Map ((v ':-> t) ': m) 40 | 41 | -- Showing map nicely 42 | instance Show (Map '[]) where 43 | show Empty = "{}" 44 | 45 | instance (KnownSymbol k, Show v, Show' (Map s)) => Show (Map ((k ':-> v) ': s)) where 46 | show (Ext k v s) = "{" ++ show k ++ " :-> " ++ show v ++ show' s ++ "}" 47 | 48 | class Show' t where 49 | show' :: t -> String 50 | instance Show' (Map '[]) where 51 | show' Empty = "" 52 | instance (KnownSymbol k, Show v, Show' (Map s)) => Show' (Map ((k ':-> v) ': s)) where 53 | show' (Ext k v s) = ", " ++ show k ++ " :-> " ++ show v ++ show' s 54 | 55 | 56 | -- Looking up from a map, and IsMembership 57 | class IsMember v t m where 58 | lookp :: Var v -> Map m -> t 59 | 60 | instance {-# OVERLAPS #-} IsMember v t ((v ':-> t) ': m) where 61 | lookp _ (Ext _ x _) = x 62 | 63 | instance IsMember v t m => IsMember v t (x ': m) where 64 | lookp v (Ext _ _ m) = lookp v m 65 | 66 | 67 | -- Updating a map 68 | class Updatable v t m n where 69 | update :: Map m -> Var v -> t -> Map n 70 | 71 | instance {-# OVERLAPS #-} Updatable v t ((v ':-> s) ': m) ((v ':-> t) ': m) where 72 | update (Ext v _ m) _ x = Ext v x m 73 | 74 | instance Updatable v t m n => Updatable v t ((w ':-> y) ': m) ((w ':-> y) ': n) where 75 | update (Ext w y m) v x = Ext w y (update m v x) 76 | 77 | instance Updatable v t '[] '[v ':-> t] where 78 | update Empty v x = Ext v x Empty 79 | -------------------------------------------------------------------------------- /UnsafeFiles.hs: -------------------------------------------------------------------------------- 1 | import System.IO 2 | 3 | example = do 4 | h <- openFile "foo" ReadMode 5 | c <- hGetChar h 6 | return [c] 7 | -------------------------------------------------------------------------------- /foo: -------------------------------------------------------------------------------- 1 | Hello London Haskellers! 2 | 3 | -------------------------------------------------------------------------------- /intro.hs: -------------------------------------------------------------------------------- 1 | import Control.Monad.State 2 | 3 | myProgram :: State Int String 4 | myProgram = do 5 | x <- get 6 | a <- somethingUmPurish x 7 | put (x+1) 8 | return (a ++ show x) 9 | 10 | somethingPure :: Int -> String 11 | somethingPure x = "hello" ++ show x 12 | 13 | somethingUmPurish :: Int -> State Int String 14 | somethingUmPurish x = do 15 | n <- get 16 | put (n + 1) 17 | return $ "hello" ++ show x 18 | -------------------------------------------------------------------------------- /slides-chalmers.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dorchard/effectful-explanations-talk/3a09225c3e4a8ae3c6af93112d1744cca332ffd9/slides-chalmers.pdf -------------------------------------------------------------------------------- /slides.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dorchard/effectful-explanations-talk/3a09225c3e4a8ae3c6af93112d1744cca332ffd9/slides.pdf --------------------------------------------------------------------------------