Slide 1
Slide 1 text
Maintainable So,ware Architeture
in Haskell (with Polysemy)
© Pawel Szulc, @EncodePanda, [email protected] 1
Slide 2
Slide 2 text
maintain [ meyn-teyn ]
verb (used with object)
1. to keep in existence
2. to keep in an appropriate condi2on, opera2on, or force; keep
unimpaired:
3. to keep in a specified state, posi2on, etc.
© Pawel Szulc, @EncodePanda, [email protected] 2
Slide 3
Slide 3 text
maintain [ meyn-teyn ]
verb (used with object)
1. to keep in existence
2. to keep in an appropriate condi.on, opera/on, or force; keep
unimpaired:
3. to keep in a specified state, posi/on, etc.
© Pawel Szulc, @EncodePanda, [email protected] 3
Slide 4
Slide 4 text
maintain [ meyn-teyn ]
verb (used with object)
1. to keep in existence
2. to keep in an appropriate condi.on, opera/on, or force; keep
unimpaired:
3. to keep in a specified state, posi/on, etc.
... in Haskell?
© Pawel Szulc, @EncodePanda, [email protected] 4
Slide 6
Slide 6 text
"Socialism Haskell is a system
language which heroically
overcomes difficul9es unknown in
any other system language"
© Pawel Szulc, @EncodePanda, [email protected] 6
Slide 8
Slide 8 text
Emphasis on what, less focus on
why?
© Pawel Szulc, @EncodePanda, [email protected] 8
Slide 9
Slide 9 text
Maintainable So,ware Architeture
in Haskell
© Pawel Szulc, @EncodePanda, [email protected] 9
Slide 10
Slide 10 text
Our plan for today
1. Coding Dojo / Hack day
2. Real world example
• problem
• approach
• consequences
• Polysemy
© Pawel Szulc, @EncodePanda, [email protected] 10
Slide 12
Slide 12 text
Why wri(ng code sucks (some(mes)?
© Pawel Szulc, @EncodePanda, [email protected] 12
Slide 13
Slide 13 text
Coding Kata: Write a sor0ng
algorithm
© Pawel Szulc, @EncodePanda, [email protected] 13
Slide 14
Slide 14 text
"As a Billing System user I want to
generate an invoice for a given
account based on its current system
use"
© Pawel Szulc, @EncodePanda, [email protected] 14
Slide 15
Slide 15 text
Func%ons and their nature
1. Manipulate data (f :: Input -> Output)
2. Interact with an outside world
© Pawel Szulc, @EncodePanda, [email protected] 15
Slide 16
Slide 16 text
doStuff :: Int -> Int
doStuff i = i + 1
Why this func,on is soooo good?
• easy to test
• you will be no/fied if its behavior changes
© Pawel Szulc, @EncodePanda, [email protected] 16
Slide 17
Slide 17 text
It's easy to maintain func0on if it
only manipulates data.
© Pawel Szulc, @EncodePanda, [email protected] 17
Slide 18
Slide 18 text
-- | take an Int (i) and UUID (uuid) as parameters
-- | fetch existing Int under given uuid from MongoDB
-- | (if does not exist, default to zero)
-- | add them, store the result, return result as text
doStuff :: UUID -> Int -> IO String
doStuff uuid i = do
maybeOld <- fetch uuid
let
oldI = maybe 0 id maybeOld
newI = oldI + i
persist uuid newI
pure ("New value: " ++ (show newI))
© Pawel Szulc, @EncodePanda, [email protected] 18
Slide 19
Slide 19 text
-- | take an Int (i) and UUID (uuid) as parameters
-- | fetch existing Int under given uuid from MongoDB
-- | (if does not exist, default to zero)
-- | add them, store the result, return result as text
doStuff :: UUID -> Int -> IO String
doStuff uuid i = do
maybeOld <- fetch uuid
let
oldI = maybe 0 id maybeOld
newI = oldI + i
persist uuid newI
pure ("New value: " ++ (show newI))
© Pawel Szulc, @EncodePanda, [email protected] 19
Slide 20
Slide 20 text
-- | take an Int (i) and UUID (uuid) as parameters
-- | fetch existing Int under given uuid from MongoDB
-- | (if does not exist, default to zero)
-- | add them, store the result, return result as text
doStuff :: UUID -> Int -> IO String
doStuff uuid i = do
maybeOld <- fetch uuid
let
oldI = maybe 0 id maybeOld
newI = oldI + i
persist uuid newI
pure ("New value: " ++ (show newI))
© Pawel Szulc, @EncodePanda, [email protected] 20
Slide 21
Slide 21 text
-- | take an Int (i) and UUID (uuid) as parameters
-- | fetch existing Int under given uuid from MongoDB
-- | (if does not exist, default to zero)
-- | add them, store the result, return result as text
doStuff :: UUID -> Int -> IO String
doStuff uuid i = do
maybeOld <- fetch uuid
let
oldI = maybe 0 id maybeOld
newI = oldI + i
persist uuid newI
pure ("New value: " ++ (show newI))
© Pawel Szulc, @EncodePanda, [email protected] 21
Slide 22
Slide 22 text
-- | take an Int (i) and UUID (uuid) as parameters
-- | fetch existing Int under given uuid from MongoDB
-- | (if does not exist, default to zero)
-- | add them, store the result, return result as text
doStuff :: UUID -> Int -> IO String
doStuff uuid i = do
maybeOld <- fetch uuid
let
oldI = maybe 0 id maybeOld
newI = oldI + i
persist uuid newI
pure ("New value: " ++ (show newI))
© Pawel Szulc, @EncodePanda, [email protected] 22
Slide 23
Slide 23 text
-- | take an Int (i) and UUID (uuid) as parameters
-- | fetch existing Int under given uuid from MongoDB
-- | (if does not exist, default to zero)
-- | add them, store the result, return result as text
doStuff :: UUID -> Int -> IO String
doStuff uuid i = do
maybeOld <- fetch uuid
let
oldI = maybe 0 id maybeOld
newI = oldI + i
persist uuid newI
pure ("New value: " ++ (show newI))
© Pawel Szulc, @EncodePanda, [email protected] 23
Slide 24
Slide 24 text
It's easy to test and maintain
func1on if it only manipulates data.
Can we change "interac.ons with
the outside world" into data?
© Pawel Szulc, @EncodePanda, [email protected] 24
Slide 25
Slide 25 text
-- | take an Int (i) and UUID (uuid) as parameters
-- | fetch existing Int under given uuid from MongoDB
-- | (if does not exist, default to zero)
-- | add them, store the result, return result as text
doStuff :: UUID -> Int -> IO String
doStuff uuid i = do
maybeOld <- fetch uuid
let
oldI = maybe 0 id maybeOld
newI = oldI + i
persist uuid newI
pure ("New value: " ++ (show newI))
© Pawel Szulc, @EncodePanda, [email protected] 25
Slide 26
Slide 26 text
Let's start with something simple
© Pawel Szulc, @EncodePanda, [email protected] 26
Slide 27
Slide 27 text
-- | take Int, return +1 as text
doStuff :: Int -> String
doStuff i = "New value: " ++ (show $ i + 1)
© Pawel Szulc, @EncodePanda, [email protected] 27
Slide 28
Slide 28 text
prop_returns_plus1 :: Property
prop_returns_plus1 = property do
-- given
i <- Gen.int
-- when
let res = doStuff i
-- then
res === "New value: " ++ (show $ i + 1)
© Pawel Szulc, @EncodePanda, [email protected] 28
Slide 29
Slide 29 text
module Main where
main :: IO ()
main = putStrLn $ doStuff 10
© Pawel Szulc, @EncodePanda, [email protected] 29
Slide 30
Slide 30 text
-- | take Int, return +1 as text
doStuff :: Int -> String
doStuff i = "New value: " ++ (show $ i + 1)
© Pawel Szulc, @EncodePanda, [email protected] 30
Slide 31
Slide 31 text
-- | take Int, return +1 as text
doStuff :: Int -> String
doStuff i = "New value: " ++ (show $ i + 1)
© Pawel Szulc, @EncodePanda, [email protected] 31
Slide 32
Slide 32 text
-- | take Int, store it, return +1 as text
doStuff :: UUID -> Int -> String
doStuff i = ...
© Pawel Szulc, @EncodePanda, [email protected] 32
Slide 43
Slide 43 text
data Storage = Persist UUID Int
-- | take Int, store it, return +1 as text
doStuff :: UUID -> Int -> (Storage, String)
doStuff uuid i =
( Persist uuid newI
, "New value: " ++ (show newI)
)
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 43
Slide 44
Slide 44 text
data Storage = Persist UUID Int
-- | take Int, store it, return +1 as text
doStuff :: UUID -> Int -> (Storage, String)
doStuff uuid i =
( Persist uuid newI
, "New value: " ++ (show newI)
)
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 44
Slide 45
Slide 45 text
data Storage = Persist UUID Int
-- | take Int, store it, return +1 as text
doStuff :: UUID -> Int -> (Storage, String)
doStuff uuid i =
( Persist uuid newI
, "New value: " ++ (show newI)
)
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 45
Slide 46
Slide 46 text
prop_returns_plus1 :: Property
prop_returns_plus1 = property $ do
-- given
i <- Gen.int
uuid <- genUUID
-- when
let result = doStuff uuid i
-- then
let expected = ( Persist uuid (i + 1)
, "New value: " ++ (show $ i + 1)
)
result === expected
© Pawel Szulc, @EncodePanda, [email protected] 46
Slide 47
Slide 47 text
prop_returns_plus1 :: Property
prop_returns_plus1 = property $ do
-- given
i <- Gen.int
uuid <- genUUID
-- when
let result = doStuff uuid i
-- then
let expected = ( Persist uuid (i + 1)
, "New value: " ++ (show $ i + 1)
)
result === expected
© Pawel Szulc, @EncodePanda, [email protected] 47
Slide 48
Slide 48 text
prop_returns_plus1 :: Property
prop_returns_plus1 = property $ do
-- given
i <- Gen.int
uuid <- genUUID
-- when
let result = doStuff uuid i
-- then
let expected = ( Persist uuid (i + 1)
, "New value: " ++ (show $ i + 1)
)
result === expected
© Pawel Szulc, @EncodePanda, [email protected] 48
Slide 49
Slide 49 text
prop_returns_plus1 :: Property
prop_returns_plus1 = property $ do
-- given
i <- Gen.int
uuid <- genUUID
-- when
let result = doStuff uuid i
-- then
let expected = ( Persist uuid (i + 1)
, "New value: " ++ (show $ i + 1)
)
result === expected
© Pawel Szulc, @EncodePanda, [email protected] 49
Slide 50
Slide 50 text
prop_returns_plus1 :: Property
prop_returns_plus1 = property $ do
-- given
i <- Gen.int
uuid <- genUUID
-- when
let result = doStuff uuid i
-- then
let expected = ( Persist uuid (i + 1)
, "New value: " ++ (show $ i + 1)
)
result === expected
© Pawel Szulc, @EncodePanda, [email protected] 50
Slide 53
Slide 53 text
doStuff :: UUID -> Int -> (Storage, String)
interpret :: (Storage, String) -> IO String
© Pawel Szulc, @EncodePanda, [email protected] 53
Slide 54
Slide 54 text
type InMemStorage = M.Map UUID Int
interpret ::
IORef InMemStorage
-> (Storage, String)
-> IO String
interpret ioRef (Persist uuid pi, i) = do
modifyIORef ioRef (M.insert uuid pi)
return i
© Pawel Szulc, @EncodePanda, [email protected] 54
Slide 55
Slide 55 text
type InMemStorage = M.Map UUID Int
interpret ::
IORef InMemStorage
-> (Storage, String)
-> IO String
interpret ioRef (Persist uuid pi, i) = do
modifyIORef ioRef (M.insert uuid pi)
return i
© Pawel Szulc, @EncodePanda, [email protected] 55
Slide 56
Slide 56 text
type InMemStorage = M.Map UUID Int
interpret ::
IORef InMemStorage
-> (Storage, String)
-> IO String
interpret ioRef (Persist uuid pi, i) = do
modifyIORef ioRef (M.insert uuid pi)
return i
© Pawel Szulc, @EncodePanda, [email protected] 56
Slide 57
Slide 57 text
type InMemStorage = M.Map UUID Int
interpret ::
IORef InMemStorage
-> (Storage, String)
-> IO String
interpret ioRef (Persist uuid pi, i) = do
modifyIORef ioRef (M.insert uuid pi)
return i
© Pawel Szulc, @EncodePanda, [email protected] 57
Slide 58
Slide 58 text
main :: IO ()
main = do
ioRef <- newIORef M.empty
uuid <- nextRandom
res <- interpret ioRef (doStuff uuid 10)
putStrLn res
© Pawel Szulc, @EncodePanda, [email protected] 58
Slide 59
Slide 59 text
-- | take Int, store it, return +1 as text
doStuff :: UUID -> Int -> (Storage, String)
doStuff uuid i =
( Persist uuid newI
, "New value: " ++ (show newI)
)
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 59
Slide 60
Slide 60 text
-- | take Int, store it once, story it twice, return +1 as text
doStuff :: UUID -> Int -> (Storage, String)
doStuff uuid i =
( Persist uuid newI
, "New value: " ++ (show newI)
)
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 60
Slide 61
Slide 61 text
-- | take Int, store it once, story it twice, return +1 as text
doStuff :: UUID -> Int -> ([Storage], String)
doStuff uuid i =
( [(Persist uuid newI)]
, "New value: " ++ (show newI)
)
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 61
Slide 66
Slide 66 text
type InMemStorage = M.Map UUID Int
interpret ::
IORef InMemStorage
-> (Storage, String)
-> IO String
interpret ioRef (Persist uuid pi, i) = do
modifyIORef ioRef (M.insert uuid pi)
return i
© Pawel Szulc, @EncodePanda, [email protected] 66
Slide 67
Slide 67 text
type InMemStorage = M.Map UUID Int
interpret ::
IORef InMemStorage
-> (Storage, String)
-> IO String
interpret ioRef (Persist uuid pi, i) = do
modifyIORef ioRef (M.insert uuid pi)
return i
© Pawel Szulc, @EncodePanda, [email protected] 67
Slide 68
Slide 68 text
type InMemStorage = M.Map UUID Int
interpret ::
IORef InMemStorage
-> ([Storage], String)
-> IO String
interpret ioRef (actions, i) = do
traverse perform actions
return i
where
perform (Persist uuid pi) =
modifyIORef ioRef (M.insert uuid pi)
© Pawel Szulc, @EncodePanda, [email protected] 68
Slide 69
Slide 69 text
type InMemStorage = M.Map UUID Int
interpret ::
IORef InMemStorage
-> ([Storage], String)
-> IO String
interpret ioRef (actions, i) = do
traverse perform actions
return i
where
perform (Persist uuid pi) =
modifyIORef ioRef (M.insert uuid pi)
© Pawel Szulc, @EncodePanda, [email protected] 69
Slide 70
Slide 70 text
type InMemStorage = M.Map UUID Int
interpret ::
IORef InMemStorage
-> ([Storage], String)
-> IO String
interpret ioRef (actions, i) = do
traverse perform actions
return i
where
perform (Persist uuid pi) =
modifyIORef ioRef (M.insert uuid pi)
© Pawel Szulc, @EncodePanda, [email protected] 70
Slide 71
Slide 71 text
type InMemStorage = M.Map UUID Int
interpret ::
IORef InMemStorage
-> ([Storage], String)
-> IO String
interpret ioRef (actions, i) = do
traverse perform actions
return i
where
perform (Persist uuid pi) =
modifyIORef ioRef (M.insert uuid pi)
© Pawel Szulc, @EncodePanda, [email protected] 71
Slide 72
Slide 72 text
type InMemStorage = M.Map UUID Int
interpret ::
IORef InMemStorage
-> ([Storage], String)
-> IO String
interpret ioRef (actions, i) = do
traverse perform actions
return i
where
perform (Persist uuid pi) =
modifyIORef ioRef (M.insert uuid pi)
© Pawel Szulc, @EncodePanda, [email protected] 72
Slide 73
Slide 73 text
type InMemStorage = M.Map UUID Int
interpret ::
IORef InMemStorage
-> ([Storage], String)
-> IO String
interpret ioRef (actions, i) = do
traverse perform actions
return i
where
perform (Persist uuid pi) =
modifyIORef ioRef (M.insert uuid pi)
© Pawel Szulc, @EncodePanda, [email protected] 73
Slide 74
Slide 74 text
prop_returns_plus1 :: Property
prop_returns_plus1 = property $ do
-- given
i <- Gen.int
uuid <- genUUID
-- when
let result = doStuff uuid i
-- then
let expected = ( Persist uuid (i + 1)
, "New value: " ++ (show $ i + 1)
)
result === expected
© Pawel Szulc, @EncodePanda, [email protected] 74
Slide 75
Slide 75 text
prop_returns_plus1 :: Property
prop_returns_plus1 = property $ do
-- given
i <- Gen.int
uuid <- genUUID
-- when
let result = doStuff uuid i
-- then
let expected = ( [Persist uuid (i + 1)]
, "New value: " ++ (show $ i + 1)
)
result === expected
© Pawel Szulc, @EncodePanda, [email protected] 75
Slide 76
Slide 76 text
main :: IO ()
main = do
ioRef <- newIORef M.empty
uuid <- nextRandom
res <- interpret ioRef (doStuff uuid 10)
putStrLn res
© Pawel Szulc, @EncodePanda, [email protected] 76
Slide 77
Slide 77 text
-- | take Int, store it once, story it twice, return +1 as text
doStuff :: UUID -> Int -> ([Storage], String)
doStuff uuid i =
( [(Persist uuid newI)]
, "New value: " ++ (show newI)
)
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 77
Slide 78
Slide 78 text
-- | take Int, store it once, story it twice, return +1 as text
doStuff :: UUID -> Int -> ([Storage], String)
doStuff uuid i =
( [ (Persist uuid newI)
, (Persist uuid newI)
]
, "New value: " ++ (show newI)
)
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 78
Slide 79
Slide 79 text
prop_returns_plus1 :: Property
prop_returns_plus1 = property $ do
-- given
i <- Gen.int
uuid <- genUUID
-- when
let result = doStuff uuid i
-- then
let expected = ( [Persist uuid (i + 1)]
, "New value: " ++ (show $ i + 1)
)
result === expected
© Pawel Szulc, @EncodePanda, [email protected] 79
Slide 80
Slide 80 text
prop_returns_plus1 :: Property
prop_returns_plus1 = property $ do
-- given
i <- Gen.int
uuid <- genUUID
-- when
let result = doStuff uuid i
-- then
let expected = ( [ Persist uuid (i + 1)
, Persist uuid (i + 1)]
, "New value: " ++ (show $ i + 1)
)
result === expected
© Pawel Szulc, @EncodePanda, [email protected] 80
Slide 82
Slide 82 text
doStuff :: UUID -> Int -> ([Storage], String)
interpret :: ([Storage], String) -> IO String
© Pawel Szulc, @EncodePanda, [email protected] 82
Slide 83
Slide 83 text
sthElse :: UUID -> Int -> ([Storage], Int)
interpret :: ([Storage], String) -> IO String
© Pawel Szulc, @EncodePanda, [email protected] 83
Slide 84
Slide 84 text
sthElse :: UUID -> Int -> ([Storage], Int)
interpret :: ([Storage], a) -> IO a
© Pawel Szulc, @EncodePanda, [email protected] 84
Slide 85
Slide 85 text
type InMemStorage = M.Map UUID Int
interpret ::
IORef InMemStorage
-> ([Storage], String)
-> IO String
interpret ioRef (actions, i) = do
traverse perform actions
return i
where
perform (Persist uuid pi) =
modifyIORef ioRef (M.insert uuid pi)
© Pawel Szulc, @EncodePanda, [email protected] 85
Slide 86
Slide 86 text
type InMemStorage = M.Map UUID Int
interpret ::
IORef InMemStorage
-> ([Storage], a)
-> IO a
interpret ioRef (actions, i) = do
traverse perform actions
return i
where
perform (Persist uuid pi) =
modifyIORef ioRef (M.insert uuid pi)
© Pawel Szulc, @EncodePanda, [email protected] 86
Slide 87
Slide 87 text
data Storage k =
Persist UUID Int
deriving stock (Eq, Show)
-- | take Int, store it once, story it twice, return +1 as text
doStuff :: UUID -> Int -> ([Storage], String)
doStuff uuid i =
( [ (Persist uuid newI)
, (Persist uuid newI)]
, "New value: " ++ (show newI)
)
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 87
Slide 88
Slide 88 text
data Storage k =
Persist UUID Int
deriving stock (Eq, Show)
-- | take Int, store it once, story it twice, return +1 as text
doStuff :: UUID -> Int -> ([Storage], String)
doStuff uuid i =
( [ (Persist uuid newI)
, (Persist uuid newI)]
, "New value: " ++ (show newI)
)
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 88
Slide 89
Slide 89 text
data Storage k =
Done k
| Persist UUID Int
deriving stock (Eq, Show)
-- | take Int, store it once, story it twice, return +1 as text
doStuff :: UUID -> Int -> [Storage String]
doStuff uuid i =
[ (Persist uuid newI)
, (Persist uuid newI)
, (Done $ "New value: " ++ (show newI))]
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 89
Slide 90
Slide 90 text
data Storage k =
Done k
| Persist UUID Int
deriving stock (Eq, Show)
-- | take Int, store it once, story it twice, return +1 as text
doStuff :: UUID -> Int -> [Storage String]
doStuff uuid i =
[ (Persist uuid newI)
, (Persist uuid newI)
, (Done $ "New value: " ++ (show newI))]
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 90
Slide 91
Slide 91 text
data Storage k =
Done k
| Persist UUID Int
deriving stock (Eq, Show)
-- | take Int, store it once, story it twice, return +1 as text
doStuff :: UUID -> Int -> [Storage String]
doStuff uuid i =
[ (Persist uuid newI)
, (Persist uuid newI)
, (Done $ "New value: " ++ (show newI))]
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 91
Slide 92
Slide 92 text
data Storage k =
Done k
| Persist UUID Int
deriving stock (Eq, Show)
-- | take Int, store it once, story it twice, return +1 as text
doStuff :: UUID -> Int -> [Storage String]
doStuff uuid i =
[ (Persist uuid newI)
, (Persist uuid newI)
, (Done $ "New value: " ++ (show newI))]
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 92
Slide 93
Slide 93 text
interpret ::
IORef InMemStorage
-> ([Storage], a)
-> IO a
interpret ioRef (actions, i) = do
traverse perform actions
return i
where
perform (Persist uuid pi) =
modifyIORef ioRef (M.insert uuid pi)
© Pawel Szulc, @EncodePanda, [email protected] 93
Slide 94
Slide 94 text
interpret ::
IORef InMemStorage
-> ([Storage], a)
-> IO a
interpret ioRef (actions, i) = do
traverse perform actions
return i
where
perform (Persist uuid pi) =
modifyIORef ioRef (M.insert uuid pi)
© Pawel Szulc, @EncodePanda, [email protected] 94
Slide 95
Slide 95 text
interpret ::
IORef InMemStorage
-> [Storage a]
-> IO a
interpret ioRef actions = do
traverse perform (init actions)
value (last actions)
where
perform (Persist uuid pi) =
modifyIORef ioRef (M.insert uuid pi)
value (Done a) = pure a
value _ = fail "failed"
© Pawel Szulc, @EncodePanda, [email protected] 95
Slide 96
Slide 96 text
interpret ::
IORef InMemStorage
-> [Storage a]
-> IO a
interpret ioRef actions = do
traverse perform (init actions)
value (last actions)
where
perform (Persist uuid pi) =
modifyIORef ioRef (M.insert uuid pi)
value (Done a) = pure a
value _ = fail "failed"
© Pawel Szulc, @EncodePanda, [email protected] 96
Slide 97
Slide 97 text
interpret ::
IORef InMemStorage
-> [Storage a]
-> IO a
interpret ioRef actions = do
traverse perform (init actions)
value (last actions)
where
perform (Persist uuid pi) =
modifyIORef ioRef (M.insert uuid pi)
value (Done a) = pure a
value _ = fail "failed"
© Pawel Szulc, @EncodePanda, [email protected] 97
Slide 98
Slide 98 text
interpret ::
IORef InMemStorage
-> [Storage a]
-> IO a
interpret ioRef actions = do
traverse perform (init actions)
value (last actions)
where
perform (Persist uuid pi) =
modifyIORef ioRef (M.insert uuid pi)
value (Done a) = pure a
value _ = fail "failed"
© Pawel Szulc, @EncodePanda, [email protected] 98
Slide 99
Slide 99 text
data Storage k =
Done k
| Persist UUID Int
deriving stock (Eq, Show)
-- | take Int, store it once, story it twice, return +1 as text
doStuff :: UUID -> Int -> [Storage String]
doStuff uuid i =
[ (Persist uuid newI)
, (Persist uuid newI)
, (Done $ "New value: " ++ (show newI))
]
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 99
Slide 100
Slide 100 text
data Storage k =
Done k
| Persist UUID Int (Storage k)
deriving stock (Eq, Show)
-- | take Int, store it once, story it twice, return +1 as text
doStuff :: UUID -> Int -> [Storage String]
doStuff uuid i =
[ (Persist uuid newI)
, (Persist uuid newI)
, (Done $ "New value: " ++ (show newI))
]
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 100
Slide 101
Slide 101 text
data Storage k =
Done k
| Persist UUID Int (Storage k)
deriving stock (Eq, Show)
-- | take Int, store it once, story it twice, return +1 as text
doStuff :: UUID -> Int -> [Storage String]
doStuff uuid i =
[ (Persist uuid newI)
, (Persist uuid newI)
, (Done $ "New value: " ++ (show newI))
]
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 101
Slide 102
Slide 102 text
data Storage k =
Done k
| Persist UUID Int (Storage k)
deriving stock (Eq, Show)
-- | take Int, store it once, story it twice, return +1 as text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i =
(Persist uuid newI
(Persist uuid newI
(Done $ "New value: " ++ (show newI))
))
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 102
Slide 103
Slide 103 text
data Storage k =
Done k
| Persist UUID Int (Storage k)
deriving stock (Eq, Show)
-- | take Int, store it once, story it twice, return +1 as text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i =
(Persist uuid newI
(Persist uuid newI
(Done $ "New value: " ++ (show newI))
))
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 103
Slide 104
Slide 104 text
data Storage k =
Done k
| Persist UUID Int (Storage k)
deriving stock (Eq, Show)
-- | take Int, store it once, story it twice, return +1 as text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i =
(Persist uuid newI
(Persist uuid newI
(Done $ "New value: " ++ (show newI))
))
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 104
Slide 105
Slide 105 text
data Storage k =
Done k
| Persist UUID Int (Storage k)
deriving stock (Eq, Show)
-- | take Int, store it once, story it twice, return +1 as text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i =
(Persist uuid newI
(Persist uuid newI
(Done $ "New value: " ++ (show newI))
))
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 105
Slide 106
Slide 106 text
interpret :: IORef InMemStorage -> Storage a -> IO a
interpret ioRef (Done a) = pure a
interpret ioRef (Persist uuid i next) =
modifyIORef ioRef (M.insert uuid i) *>
interpret ioRef next
© Pawel Szulc, @EncodePanda, [email protected] 106
Slide 107
Slide 107 text
interpret :: IORef InMemStorage -> Storage a -> IO a
interpret ioRef (Done a) = pure a
interpret ioRef (Persist uuid i next) =
modifyIORef ioRef (M.insert uuid i) *>
interpret ioRef next
© Pawel Szulc, @EncodePanda, [email protected] 107
Slide 108
Slide 108 text
interpret :: IORef InMemStorage -> Storage a -> IO a
interpret ioRef (Done a) = pure a
interpret ioRef (Persist uuid i next) =
modifyIORef ioRef (M.insert uuid i) *>
interpret ioRef next
© Pawel Szulc, @EncodePanda, [email protected] 108
Slide 111
Slide 111 text
interpret :: IORef InMemStorage -> Storage a -> IO a
interpret ioRef (Done a) = pure a
interpret ioRef (Persist uuid i next) =
modifyIORef ioRef (M.insert uuid i) *>
interpret ioRef next
© Pawel Szulc, @EncodePanda, [email protected] 111
Slide 112
Slide 112 text
data Storage k =
Done k
| Persist UUID Int (Storage k)
deriving stock (Eq, Show)
-- | take Int, store it once, story it twice, return +1 as text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i =
(Persist uuid newI
(Persist uuid newI
(Done $ "New value: " ++ (show newI))
))
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 112
Slide 113
Slide 113 text
data Storage k =
Done k
| Persist UUID Int (Storage k)
deriving stock (Eq, Show)
© Pawel Szulc, @EncodePanda, [email protected] 113
Slide 114
Slide 114 text
data Storage k =
Done k
| Persist UUID Int (Storage k)
deriving stock (Functor, Eq, Show)
© Pawel Szulc, @EncodePanda, [email protected] 114
Slide 115
Slide 115 text
data Storage k =
Done k
| Persist UUID Int (Storage k)
deriving stock (Functor, Eq, Show)
instance Applicative Storage where
pure a = Done a
(<*>) func (Done a) =
fmap (\f -> f a) func
(<*>) func (Persist uuid i next) =
Persist uuid i (func <*> next)
© Pawel Szulc, @EncodePanda, [email protected] 115
Slide 116
Slide 116 text
-- | take Int, store it once, story it twice, return +1 as text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i =
(Persist uuid newI
(Persist uuid newI
(Done $ "New value: " ++ (show newI))
))
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 116
Slide 117
Slide 117 text
-- | take Int, store it once, story it twice, return +1 as text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i =
Persist uuid newI (Done ()) *>
Persist uuid newI (Done ()) *>
pure ("New value: " ++ (show newI))
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 117
Slide 118
Slide 118 text
-- | take Int, store it once, story it twice, return +1 as text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i =
Persist uuid newI (Done ()) *>
Persist uuid newI (Done ()) *>
pure ("New value: " ++ (show newI))
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 118
Slide 119
Slide 119 text
-- | take Int, store it once, story it twice, return +1 as text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i =
Persist uuid newI (Done ()) *>
Persist uuid newI (Done ()) *>
pure ("New value: " ++ (show newI))
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 119
Slide 120
Slide 120 text
-- | take Int, store it once, story it twice, return +1 as text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i =
Persist uuid newI (Done ()) *>
Persist uuid newI (Done ()) *>
pure ("New value: " ++ (show newI))
where
newI = i + 1
© Pawel Szulc, @EncodePanda, [email protected] 120
Slide 121
Slide 121 text
-- | take Int, store it once, story it twice, return +1 as text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i =
persist uuid newI *>
persist uuid newI *>
pure ("New value: " ++ (show newI))
where
newI = i + 1
persist :: UUID -> Int -> Storage ()
persist uuid i = Persist uuid i (Done ())
© Pawel Szulc, @EncodePanda, [email protected] 121
Slide 122
Slide 122 text
-- | take Int, fetch existing Int (if does not exist, default to zero)
-- | add them, store the result, return result as text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i =
fetch uuid *>
persist ...
data Storage k =
Done k
| Persist UUID Int (Storage k)
| Fetch UUID ...
deriving stock (Functor)
fetch :: UUID -> Storage (Maybe Int)
© Pawel Szulc, @EncodePanda, [email protected] 122
Slide 123
Slide 123 text
-- | take Int, fetch existing Int (if does not exist, default to zero)
-- | add them, store the result, return result as text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i =
fetch uuid *>
persist ...
data Storage k =
Done k
| Persist UUID Int (Storage k)
| Fetch UUID ...
deriving stock (Functor)
fetch :: UUID -> Storage (Maybe Int)
© Pawel Szulc, @EncodePanda, [email protected] 123
Slide 124
Slide 124 text
-- | take Int, fetch existing Int (if does not exist, default to zero)
-- | add them, store the result, return result as text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i =
fetch uuid *>
persist ...
data Storage k =
Done k
| Persist UUID Int (Storage k)
| Fetch UUID ...
deriving stock (Functor)
fetch :: UUID -> Storage (Maybe Int)
© Pawel Szulc, @EncodePanda, [email protected] 124
Slide 125
Slide 125 text
-- | take Int, fetch existing Int (if does not exist, default to zero)
-- | add them, store the result, return result as text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i =
fetch uuid *>
persist ...
data Storage k =
Done k
| Persist UUID Int (Storage k)
| Fetch UUID ...
deriving stock (Functor)
fetch :: UUID -> Storage (Maybe Int)
© Pawel Szulc, @EncodePanda, [email protected] 125
Slide 126
Slide 126 text
-- | take Int, fetch existing Int (if does not exist, default to zero)
-- | add them, store the result, return result as text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i =
fetch uuid *>
persist ...
data Storage k =
Done k
| Persist UUID Int (Storage k)
| Fetch UUID ...
deriving stock (Functor)
fetch :: UUID -> Storage (Maybe Int)
© Pawel Szulc, @EncodePanda, [email protected] 126
Slide 127
Slide 127 text
data Storage k =
Done k
| Persist UUID Int (Storage k)
deriving stock (Functor)
© Pawel Szulc, @EncodePanda, [email protected] 127
Slide 128
Slide 128 text
data Storage k =
Done k
| Persist UUID Int (Storage k)
| Fetch UUID (Maybe Int -> Storage k)
deriving stock (Functor)
© Pawel Szulc, @EncodePanda, [email protected] 128
Slide 129
Slide 129 text
data Storage k =
Done k
| Persist UUID Int (Storage k)
| Fetch UUID (Maybe Int -> Storage k)
deriving stock (Functor)
persist :: UUID -> Int -> Storage ()
persist uuid i = Persist uuid i (Done ())
fetch :: UUID -> Storage (Maybe Int)
fetch uuid = Fetch uuid (\mi -> Done mi)
© Pawel Szulc, @EncodePanda, [email protected] 129
Slide 130
Slide 130 text
data Storage k =
Done k
| Persist UUID Int (Storage k)
| Fetch UUID (Maybe Int -> Storage k)
deriving stock (Functor)
persist :: UUID -> Int -> Storage ()
persist uuid i = Persist uuid i (Done ())
fetch :: UUID -> Storage (Maybe Int)
fetch uuid = Fetch uuid pure
© Pawel Szulc, @EncodePanda, [email protected] 130
Slide 131
Slide 131 text
"Sequen'ally compose two ac'ons,
passing any value produced by the
first as an argument to the second."
© Pawel Szulc, @EncodePanda, [email protected] 131
Slide 132
Slide 132 text
??? :: m a -> (a -> m b) -> m b
© Pawel Szulc, @EncodePanda, [email protected] 132
Slide 133
Slide 133 text
>>= :: m a -> (a -> m b) -> m b
© Pawel Szulc, @EncodePanda, [email protected] 133
Slide 134
Slide 134 text
instance Monad Storage where
(Done a) >>= f = f a
(Persist uuid i next) >>= f =
Persist uuid i (next >>= f)
(Fetch uuid nextFunc) >>= f =
Fetch uuid (\mi -> (nextFunc mi) >>= f)
© Pawel Szulc, @EncodePanda, [email protected] 134
Slide 136
Slide 136 text
-- | take Int, fetch existing Int
-- | (if does not exist, default to zero)
-- | add them,
-- | store the result,
-- | return result as text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i = do
maybeOld <- fetch uuid
let
oldI = maybe 0 id maybeOld
newI = oldI + i
persist uuid newI
pure ("New value: " ++ (show newI))
© Pawel Szulc, @EncodePanda, [email protected] 136
Slide 137
Slide 137 text
-- | take Int, fetch existing Int
-- | (if does not exist, default to zero)
-- | add them,
-- | store the result,
-- | return result as text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i = do
maybeOld <- fetch uuid
let
oldI = maybe 0 id maybeOld
newI = oldI + i
persist uuid newI
pure ("New value: " ++ (show newI))
© Pawel Szulc, @EncodePanda, [email protected] 137
Slide 138
Slide 138 text
-- | take Int, fetch existing Int
-- | (if does not exist, default to zero)
-- | add them,
-- | store the result,
-- | return result as text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i = do
maybeOld <- fetch uuid
let
oldI = maybe 0 id maybeOld
newI = oldI + i
persist uuid newI
pure ("New value: " ++ (show newI))
© Pawel Szulc, @EncodePanda, [email protected] 138
Slide 139
Slide 139 text
-- | take Int, fetch existing Int
-- | (if does not exist, default to zero)
-- | add them,
-- | store the result,
-- | return result as text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i = do
maybeOld <- fetch uuid
let
oldI = maybe 0 id maybeOld
newI = oldI + i
persist uuid newI
pure ("New value: " ++ (show newI))
© Pawel Szulc, @EncodePanda, [email protected] 139
Slide 140
Slide 140 text
-- | take Int, fetch existing Int
-- | (if does not exist, default to zero)
-- | add them,
-- | store the result,
-- | return result as text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i = do
maybeOld <- fetch uuid
let
oldI = maybe 0 id maybeOld
newI = oldI + i
persist uuid newI
pure ("New value: " ++ (show newI))
© Pawel Szulc, @EncodePanda, [email protected] 140
Slide 141
Slide 141 text
-- | take Int, fetch existing Int
-- | (if does not exist, default to zero)
-- | add them,
-- | store the result,
-- | return result as text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i = do
maybeOld <- fetch uuid
let
oldI = maybe 0 id maybeOld
newI = oldI + i
persist uuid newI
pure ("New value: " ++ (show newI))
© Pawel Szulc, @EncodePanda, [email protected] 141
Slide 142
Slide 142 text
-- | take Int, fetch existing Int
-- | (if does not exist, default to zero)
-- | add them,
-- | store the result,
-- | return result as text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i = do
maybeOld <- fetch uuid
let
oldI = maybe 0 id maybeOld
newI = oldI + i
persist uuid newI
pure ("New value: " ++ (show newI))
© Pawel Szulc, @EncodePanda, [email protected] 142
Slide 143
Slide 143 text
type InMemStorage = M.Map UUID Int
interpret :: IORef InMemStorage -> Storage a -> IO a
interpret ioRef (Done a) = pure a
interpret ioRef (Persist uuid i next) =
(modifyIORef ioRef (M.insert uuid i)) *> (interpret ioRef next)
interpret ioRef (Fetch uuid nextFunc) = do
inmem <- readIORef ioRef
let maybeI = M.lookup uuid inmem
interpret ioRef (nextFunc maybeI)
© Pawel Szulc, @EncodePanda, [email protected] 143
Slide 144
Slide 144 text
type InMemStorage = M.Map UUID Int
interpret :: IORef InMemStorage -> Storage a -> IO a
interpret ioRef (Done a) = pure a
interpret ioRef (Persist uuid i next) =
(modifyIORef ioRef (M.insert uuid i)) *> (interpret ioRef next)
interpret ioRef (Fetch uuid nextFunc) = do
inmem <- readIORef ioRef
let maybeI = M.lookup uuid inmem
interpret ioRef (nextFunc maybeI)
© Pawel Szulc, @EncodePanda, [email protected] 144
Slide 145
Slide 145 text
type InMemStorage = M.Map UUID Int
interpret :: IORef InMemStorage -> Storage a -> IO a
interpret ioRef (Done a) = pure a
interpret ioRef (Persist uuid i next) =
(modifyIORef ioRef (M.insert uuid i)) *> (interpret ioRef next)
interpret ioRef (Fetch uuid nextFunc) = do
inmem <- readIORef ioRef
let maybeI = M.lookup uuid inmem
interpret ioRef (nextFunc maybeI)
© Pawel Szulc, @EncodePanda, [email protected] 145
Slide 146
Slide 146 text
type InMemStorage = M.Map UUID Int
interpret :: IORef InMemStorage -> Storage a -> IO a
interpret ioRef (Done a) = pure a
interpret ioRef (Persist uuid i next) =
(modifyIORef ioRef (M.insert uuid i)) *> (interpret ioRef next)
interpret ioRef (Fetch uuid nextFunc) = do
inmem <- readIORef ioRef
let maybeI = M.lookup uuid inmem
interpret ioRef (nextFunc maybeI)
© Pawel Szulc, @EncodePanda, [email protected] 146
Slide 147
Slide 147 text
type InMemStorage = M.Map UUID Int
interpret :: IORef InMemStorage -> Storage a -> IO a
interpret ioRef (Done a) = pure a
interpret ioRef (Persist uuid i next) =
(modifyIORef ioRef (M.insert uuid i)) *> (interpret ioRef next)
interpret ioRef (Fetch uuid nextFunc) = do
inmem <- readIORef ioRef
let maybeI = M.lookup uuid inmem
interpret ioRef (nextFunc maybeI)
© Pawel Szulc, @EncodePanda, [email protected] 147
Slide 148
Slide 148 text
type InMemStorage = M.Map UUID Int
interpret :: IORef InMemStorage -> Storage a -> IO a
interpret ioRef (Done a) = pure a
interpret ioRef (Persist uuid i next) =
(modifyIORef ioRef (M.insert uuid i)) *> (interpret ioRef next)
interpret ioRef (Fetch uuid nextFunc) = do
inmem <- readIORef ioRef
let maybeI = M.lookup uuid inmem
interpret ioRef (nextFunc maybeI)
© Pawel Szulc, @EncodePanda, [email protected] 148
Slide 149
Slide 149 text
prop_fetch_add_store_return :: Property
prop_fetch_add_store_return = property $ do
-- given
i <- Gen.int
uuid <- genUUID
initial <- Gen.int
ioRef <- evalIO $ newIORef $ M.singleton uuid initial
-- when
res <- evalIO $ interpret ioRef (doStuff uuid i)
-- then
inmem <- evalIO $ readIORef ioRef
res === "New value: " ++ show (i + initial)
M.toList inmem === [(uuid, i + initial)]
© Pawel Szulc, @EncodePanda, [email protected] 149
Slide 150
Slide 150 text
doStuff :: UUID -> Int -> IO String
doStuff uuid i = do
maybeOld <- fetch uuid
let
oldI = maybe 0 id maybeOld
newI = oldI + i
persist uuid newI
pure ("New value: " ++ (show newI))
© Pawel Szulc, @EncodePanda, [email protected] 150
Slide 151
Slide 151 text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i = do
maybeOld <- fetch uuid
let
oldI = maybe 0 id maybeOld
newI = oldI + i
persist uuid newI
pure ("New value: " ++ (show newI))
© Pawel Szulc, @EncodePanda, [email protected] 151
Slide 152
Slide 152 text
data Storage k =
Done k
| Persist UUID Int (Storage k)
| Fetch UUID (Maybe Int -> Storage k)
deriving stock (Functor)
instance Applicative Storage where
pure a = Done a
(<*>) func (Done a) = fmap (\f -> f a) func
(<*>) func (Persist uuid i next) = Persist uuid i (func <*> next)
instance Monad Storage where
(Done a) >>= f = f a
(Persist uuid i next) >>= f = Persist uuid i (next >>= f)
(Fetch uuid nextFunc) >>= f = Fetch uuid (\mi -> (nextFunc mi) >>= f)
© Pawel Szulc, @EncodePanda, [email protected] 152
Slide 154
Slide 154 text
data Storage k =
Done k
| Persist UUID Int (Storage k)
| Fetch UUID (Maybe Int -> Storage k)
deriving stock (Functor)
© Pawel Szulc, @EncodePanda, [email protected] 154
Slide 155
Slide 155 text
data Storage k =
Persist UUID Int k
| Fetch UUID (Maybe Int -> k)
deriving stock (Functor)
data Free (f:: * -> *) (k :: *) =
Pure k |
Impure (f (Free f k))
© Pawel Szulc, @EncodePanda, [email protected] 155
Slide 156
Slide 156 text
data Storage k =
Persist UUID Int k
| Fetch UUID (Maybe Int -> k)
deriving stock (Functor)
data Free (f:: * -> *) (k :: *) =
Pure k |
Impure (f (Free f k))
persist :: UUID -> Int -> Free Storage ()
persist uuid i = Impure (Persist uuid i (Pure ()))
fetch :: UUID -> Free Storage (Maybe Int)
fetch uuid = Impure (Fetch uuid (\mi -> Pure mi))
© Pawel Szulc, @EncodePanda, [email protected] 156
Slide 157
Slide 157 text
instance Functor f => Functor (Free f) where
fmap f (Pure k) = Pure $ f k
fmap f (Impure c) = Impure (fmap (fmap f) c)
instance Functor f => Applicative (Free f) where
pure a = Pure a
(<*>) func (Pure a) = fmap (\f -> f a) func
(<*>) func (Impure c) = Impure (fmap (\f -> func <*> f) c)
instance Functor f => Monad (Free f) where
Pure k >>= f = f k
Impure c >>= f = Impure $ fmap (\x -> x >>= f) c
© Pawel Szulc, @EncodePanda, [email protected] 157
Slide 158
Slide 158 text
data Storage k =
Persist UUID Int k
| Fetch UUID (Maybe Int -> k)
deriving stock (Functor)
© Pawel Szulc, @EncodePanda, [email protected] 158
Slide 159
Slide 159 text
doStuff :: UUID -> Int -> Storage String
doStuff uuid i = do
maybeOld <- fetch uuid
let
oldI = maybe 0 id maybeOld
newI = oldI + i
persist uuid newI
pure ("New value: " ++ (show newI))
© Pawel Szulc, @EncodePanda, [email protected] 159
Slide 160
Slide 160 text
doStuff :: UUID -> Int -> Free Storage String
doStuff uuid i = do
maybeOld <- fetch uuid
let
oldI = maybe 0 id maybeOld
newI = oldI + i
persist uuid newI
pure ("New value: " ++ (show newI))
© Pawel Szulc, @EncodePanda, [email protected] 160
Slide 161
Slide 161 text
interpretFree ::
Monad m
=> (forall x. f x -> m x)
-> Free f a
-> m a
interpretFree _ (Pure a) = pure a
interpretFree f (Impure c) = f c >>= interpretFree f
© Pawel Szulc, @EncodePanda, [email protected] 161
Slide 162
Slide 162 text
interpretFree ::
Monad m
=> (forall x. f x -> m x)
-> Free f a
-> m a
interpretFree _ (Pure a) = pure a
interpretFree f (Impure c) = f c >>= interpretFree f
interpret :: IORef InMemStorage -> Storage a -> IO a
interpret ioRef (Persist uuid i k) = do
modifyIORef ioRef (M.insert uuid i)
pure k
interpret ioRef (Fetch uuid kFunc) = do
inmem <- readIORef ioRef
let maybeI = M.lookup uuid inmem
pure $ kFunc maybeI
© Pawel Szulc, @EncodePanda, [email protected] 162
Slide 163
Slide 163 text
interpretFree ::
Monad m
=> (forall x. f x -> m x)
-> Free f a
-> m a
interpretFree _ (Pure a) = pure a
interpretFree f (Impure c) = f c >>= interpretFree f
interpret :: IORef InMemStorage -> Storage a -> IO a
interpret ioRef (Persist uuid i k) = do
modifyIORef ioRef (M.insert uuid i)
pure k
interpret ioRef (Fetch uuid kFunc) = do
inmem <- readIORef ioRef
let maybeI = M.lookup uuid inmem
pure $ kFunc maybeI
© Pawel Szulc, @EncodePanda, [email protected] 163
Slide 164
Slide 164 text
interpretFree ::
Monad m
=> (forall x. f x -> m x)
-> Free f a
-> m a
interpretFree _ (Pure a) = pure a
interpretFree f (Impure c) = f c >>= interpretFree f
interpret :: IORef InMemStorage -> Storage a -> IO a
interpret ioRef (Persist uuid i k) = do
modifyIORef ioRef (M.insert uuid i)
pure k
interpret ioRef (Fetch uuid kFunc) = do
inmem <- readIORef ioRef
let maybeI = M.lookup uuid inmem
pure $ kFunc maybeI
© Pawel Szulc, @EncodePanda, [email protected] 164
Slide 165
Slide 165 text
interpretFree ::
Monad m
=> (forall x. f x -> m x)
-> Free f a
-> m a
interpretFree _ (Pure a) = pure a
interpretFree f (Impure c) = f c >>= interpretFree f
interpret :: IORef InMemStorage -> Storage a -> IO a
interpret ioRef (Persist uuid i k) = do
modifyIORef ioRef (M.insert uuid i)
pure k
interpret ioRef (Fetch uuid kFunc) = do
inmem <- readIORef ioRef
let maybeI = M.lookup uuid inmem
pure $ kFunc maybeI
© Pawel Szulc, @EncodePanda, [email protected] 165
Slide 166
Slide 166 text
interpretFree :: (f x -> m x) -> Free f a -> m a
interpret :: IORef InMemStorage -> Storage a -> IO a
© Pawel Szulc, @EncodePanda, [email protected] 166
Slide 167
Slide 167 text
prop_fetch_add_store_return :: Property
prop_fetch_add_store_return = property $ do
-- given
i <- Gen.int
uuid <- genUUID
initial <- Gen.int
ioRef <- evalIO $ newIORef $ M.singleton uuid initial
-- when
res <- evalIO $ interpret ioRef (doStuff uuid i)
-- then
inmem <- evalIO $ readIORef ioRef
res === "New value: " ++ show (i + initial)
M.toList inmem === [(uuid, i + initial)]
© Pawel Szulc, @EncodePanda, [email protected] 167
Slide 168
Slide 168 text
prop_fetch_add_store_return :: Property
prop_fetch_add_store_return = property $ do
-- given
i <- Gen.int
uuid <- genUUID
initial <- Gen.int
ioRef <- evalIO $ newIORef $ M.singleton uuid initial
-- when
res <- evalIO $ interpret ioRef (doStuff uuid i)
-- then
inmem <- evalIO $ readIORef ioRef
res === "New value: " ++ show (i + initial)
M.toList inmem === [(uuid, i + initial)]
© Pawel Szulc, @EncodePanda, [email protected] 168
Slide 169
Slide 169 text
prop_fetch_add_store_return :: Property
prop_fetch_add_store_return = property $ do
-- given
i <- Gen.int
uuid <- genUUID
initial <- Gen.int
ioRef <- evalIO $ newIORef $ M.singleton uuid initial
-- when
res <- evalIO $ interpretFree (interpret ioRef) (doStuff uuid i)
-- then
inmem <- evalIO $ readIORef ioRef
res === "New value: " ++ show (i + initial)
M.toList inmem === [(uuid, i + initial)]
© Pawel Szulc, @EncodePanda, [email protected] 169
Slide 171
Slide 171 text
"As a Billing System user I want to
generate an invoice for a given
account based on its current system
use"
© Pawel Szulc, @EncodePanda, [email protected] 171
Slide 186
Slide 186 text
To generate invoice for account account_id
1. fetch profile from CRM
2. fetch CDRs from FTP
3. generate invoice number
4. total = sum cdrs
5. glue together
© Pawel Szulc, @EncodePanda, [email protected] 186
Slide 188
Slide 188 text
h"ps:/
/github.com/polysemy-research/polysemy
© Pawel Szulc, @EncodePanda, [email protected] 188
Slide 189
Slide 189 text
Sem r a
.
program :: Sem '[Console, (Random Int)] Int
© Pawel Szulc, @EncodePanda, [email protected] 189
Slide 190
Slide 190 text
Sem r a
.
program :: Sem '[Console, (Random Int)] Int
© Pawel Szulc, @EncodePanda, [email protected] 190
Slide 191
Slide 191 text
Sem r a
.
program :: Sem '[Console, (Random Int)] Int
© Pawel Szulc, @EncodePanda, [email protected] 191
Slide 192
Slide 192 text
Sem r a
___
program :: Sem '[Console, (Random Int)] Int
___
.________________________________________^
© Pawel Szulc, @EncodePanda, [email protected] 192
Slide 193
Slide 193 text
Sem r a
.
program :: Sem '[Console, (Random Int)] Int
© Pawel Szulc, @EncodePanda, [email protected] 193
Slide 194
Slide 194 text
Sem r a
________________________
program :: Sem '[Console, (Random Int)] Int
________________________
.________________________^
© Pawel Szulc, @EncodePanda, [email protected] 194
Slide 195
Slide 195 text
Sem r a
.
program :: Sem '[Console, (Random Int)] Int
© Pawel Szulc, @EncodePanda, [email protected] 195
Slide 196
Slide 196 text
Sem r a
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
.
© Pawel Szulc, @EncodePanda, [email protected] 196
Slide 197
Slide 197 text
Sem r a
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
.________^
© Pawel Szulc, @EncodePanda, [email protected] 197
Slide 198
Slide 198 text
Sem r a
program ::
Member Console r <|
=> Member (Random Int) r <|
=> Sem r Int |
.________^_____________________|
© Pawel Szulc, @EncodePanda, [email protected] 198
Slide 199
Slide 199 text
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
data Console m a where
PrintLine :: String -> Console m ()
ReadLine :: Console m String
makeSem ''Console
printLine :: Member Console r => String -> Sem r ()
readLine :: Member Console r => Sem r String
© Pawel Szulc, @EncodePanda, [email protected] 199
Slide 200
Slide 200 text
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
data Console m a where
PrintLine :: String -> Console m ()
ReadLine :: Console m String
makeSem ''Console
printLine :: Member Console r => String -> Sem r ()
readLine :: Member Console r => Sem r String
© Pawel Szulc, @EncodePanda, [email protected] 200
Slide 201
Slide 201 text
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
data Console m a where
PrintLine :: String -> Console m ()
ReadLine :: Console m String
makeSem ''Console
printLine :: Member Console r => String -> Sem r ()
readLine :: Member Console r => Sem r String
© Pawel Szulc, @EncodePanda, [email protected] 201
Slide 202
Slide 202 text
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
data Console m a where
PrintLine :: String -> Console m ()
ReadLine :: Console m String
makeSem ''Console
printLine :: Member Console r => String -> Sem r ()
readLine :: Member Console r => Sem r String
© Pawel Szulc, @EncodePanda, [email protected] 202
Slide 203
Slide 203 text
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
data Console m a where
PrintLine :: String -> Console m ()
ReadLine :: Console m String
makeSem ''Console
printLine :: Member Console r => String -> Sem r ()
readLine :: Member Console r => Sem r String
© Pawel Szulc, @EncodePanda, [email protected] 203
Slide 204
Slide 204 text
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
data Console m a where
PrintLine :: String -> Console m ()
ReadLine :: Console m String
makeSem ''Console
printLine :: Member Console r => String -> Sem r ()
readLine :: Member Console r => Sem r String
© Pawel Szulc, @EncodePanda, [email protected] 204
Slide 205
Slide 205 text
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
data Console m a where
PrintLine :: String -> Console m ()
ReadLine :: Console m String
makeSem ''Console
printLine :: Member Console r => String -> Sem r ()
readLine :: Member Console r => Sem r String
© Pawel Szulc, @EncodePanda, [email protected] 205
Slide 206
Slide 206 text
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
data Console m a where
PrintLine :: String -> Console m ()
ReadLine :: Console m String
makeSem ''Console
printLine :: Member Console r => String -> Sem r ()
readLine :: Member Console r => Sem r String
© Pawel Szulc, @EncodePanda, [email protected] 206
Slide 207
Slide 207 text
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
data Random v m a where
NextRandom :: Random v m v
makeSem ''Random
nextRandom :: Member (Random v) r => Sem r v
© Pawel Szulc, @EncodePanda, [email protected] 207
Slide 208
Slide 208 text
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
data Random v m a where
NextRandom :: Random v m v
makeSem ''Random
nextRandom :: Member (Random v) r => Sem r v
© Pawel Szulc, @EncodePanda, [email protected] 208
Slide 209
Slide 209 text
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
data Random v m a where
NextRandom :: Random v m v
makeSem ''Random
nextRandom :: Member (Random v) r => Sem r v
© Pawel Szulc, @EncodePanda, [email protected] 209
Slide 210
Slide 210 text
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
data Random v m a where
NextRandom :: Random v m v
makeSem ''Random
nextRandom :: Member (Random v) r => Sem r v
© Pawel Szulc, @EncodePanda, [email protected] 210
Slide 211
Slide 211 text
-- cheatsheet
printLine :: Member Console r => String -> Sem r ()
readLine :: Member Console r => Sem r String
nextRandom :: Member (Random v) r => Sem r v
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
program = do
printLine "Insert your number:"
i1 <- readLine
i2 <- nextRandom
pure (read i1 + i2)
© Pawel Szulc, @EncodePanda, [email protected] 211
Slide 212
Slide 212 text
-- cheatsheet
printLine :: Member Console r => String -> Sem r ()
readLine :: Member Console r => Sem r String
nextRandom :: Member (Random v) r => Sem r v
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
program = do
printLine "Insert your number:"
i1 <- readLine
i2 <- nextRandom
pure (read i1 + i2)
© Pawel Szulc, @EncodePanda, [email protected] 212
Slide 213
Slide 213 text
-- cheatsheet
printLine :: Member Console r => String -> Sem r ()
readLine :: Member Console r => Sem r String
nextRandom :: Member (Random v) r => Sem r v
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
program = do
printLine "Insert your number:"
i1 <- readLine
i2 <- nextRandom
pure (read i1 + i2)
© Pawel Szulc, @EncodePanda, [email protected] 213
Slide 214
Slide 214 text
-- cheatsheet
printLine :: Member Console r => String -> Sem r ()
readLine :: Member Console r => Sem r String
nextRandom :: Member (Random v) r => Sem r v
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
program = do
printLine "Insert your number:"
i1 <- readLine
i2 <- nextRandom
pure (read i1 + i2)
© Pawel Szulc, @EncodePanda, [email protected] 214
Slide 215
Slide 215 text
-- cheatsheet
printLine :: Member Console r => String -> Sem r ()
readLine :: Member Console r => Sem r String
nextRandom :: Member (Random v) r => Sem r v
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
program = do
printLine "Insert your number:"
i1 <- readLine
i2 <- nextRandom
pure (read i1 + i2)
© Pawel Szulc, @EncodePanda, [email protected] 215
Slide 216
Slide 216 text
-- cheatsheet
printLine :: Member Console r => String -> Sem r ()
readLine :: Member Console r => Sem r String
nextRandom :: Member (Random v) r => Sem r v
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
program = do
printLine "Insert your number:"
i1 <- readLine
i2 <- nextRandom
pure (read i1 + i2)
© Pawel Szulc, @EncodePanda, [email protected] 216
Slide 217
Slide 217 text
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
program = do
printLine "Insert your number:"
i1 <- readLine
i2 <- nextRandom
pure (read i1 + i2)
-- Sem r a ~> IO a ?
© Pawel Szulc, @EncodePanda, [email protected] 217
Slide 218
Slide 218 text
run :: Sem '[] a -> a
runM :: Monad m
=> Sem '[Embed m] a -> m a
-- Sem '[Embed IO] a -> IO a
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
-- Sem '[Console, Random Int] Int
© Pawel Szulc, @EncodePanda, [email protected] 218
Slide 219
Slide 219 text
run :: Sem '[] a -> a
runM :: Monad m
=> Sem '[Embed m] a -> m a
-- Sem '[Embed IO] a -> IO a
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
-- Sem '[Console, Random Int] Int
© Pawel Szulc, @EncodePanda, [email protected] 219
Slide 220
Slide 220 text
run :: Sem '[] a -> a
runM :: Monad m
=> Sem '[Embed m] a -> m a
-- Sem '[Embed IO] a -> IO a
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
-- Sem '[Console, Random Int] Int
© Pawel Szulc, @EncodePanda, [email protected] 220
Slide 221
Slide 221 text
run :: Sem '[] a -> a
runM :: Monad m
=> Sem '[Embed m] a -> m a
-- Sem '[Embed IO] a -> IO a
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
-- Sem '[Console, Random Int] Int
© Pawel Szulc, @EncodePanda, [email protected] 221
Slide 222
Slide 222 text
run :: Sem '[] a -> a
runM :: Monad m
=> Sem '[Embed m] a -> m a
-- Sem '[Embed IO] a -> IO a
program ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
-- Sem '[Console, Random Int] Int
© Pawel Szulc, @EncodePanda, [email protected] 222
Slide 223
Slide 223 text
What we need is an interpreter
© Pawel Szulc, @EncodePanda, [email protected] 223
Slide 224
Slide 224 text
data Console m a where
PrintLine :: String -> Console m ()
ReadLine :: Console m String
runConsoleIO ::
Member (Embed IO) r
=> Sem (Console ': r) a -> Sem r a
runConsoleIO = interpret $ \case
PrintLine line -> putStrLn line
ReadLine -> getLine
© Pawel Szulc, @EncodePanda, [email protected] 224
Slide 225
Slide 225 text
data Console m a where
PrintLine :: String -> Console m ()
ReadLine :: Console m String
runConsoleIO ::
Member (Embed IO) r
=> Sem (Console ': r) a -> Sem r a
runConsoleIO = interpret $ \case
PrintLine line -> putStrLn line
ReadLine -> getLine
© Pawel Szulc, @EncodePanda, [email protected] 225
Slide 226
Slide 226 text
data Console m a where
PrintLine :: String -> Console m ()
ReadLine :: Console m String
runConsoleIO ::
Member (Embed IO) r
=> Sem (Console ': r) a -> Sem r a
runConsoleIO = interpret $ \case
PrintLine line -> putStrLn line
ReadLine -> getLine
© Pawel Szulc, @EncodePanda, [email protected] 226
Slide 227
Slide 227 text
data Console m a where
PrintLine :: String -> Console m ()
ReadLine :: Console m String
runConsoleIO ::
Member (Embed IO) r
=> Sem (Console ': r) a -> Sem r a
runConsoleIO = interpret $ \case
PrintLine line -> putStrLn line
ReadLine -> getLine
© Pawel Szulc, @EncodePanda, [email protected] 227
Slide 228
Slide 228 text
data Console m a where
PrintLine :: String -> Console m ()
ReadLine :: Console m String
runConsoleIO ::
Member (Embed IO) r
=> Sem (Console ': r) a -> Sem r a
runConsoleIO = interpret $ \case
PrintLine line -> putStrLn line
ReadLine -> getLine
© Pawel Szulc, @EncodePanda, [email protected] 228
Slide 229
Slide 229 text
data Console m a where
PrintLine :: String -> Console m ()
ReadLine :: Console m String
runConsoleIO ::
Member (Embed IO) r
=> Sem (Console ': r) a -> Sem r a
runConsoleIO = interpret $ \case
PrintLine line -> putStrLn line
ReadLine -> getLine
© Pawel Szulc, @EncodePanda, [email protected] 229
Slide 230
Slide 230 text
data Console m a where
PrintLine :: String -> Console m ()
ReadLine :: Console m String
-- embed :: Member (Embed m) r => m a -> Sem r a
runConsoleIO ::
Member (Embed IO) r
=> Sem (Console ': r) a -> Sem r a
runConsoleIO = interpret $ \case
PrintLine line -> putStrLn line
ReadLine -> getLine
© Pawel Szulc, @EncodePanda, [email protected] 230
Slide 231
Slide 231 text
data Console m a where
PrintLine :: String -> Console m ()
ReadLine :: Console m String
-- embed :: Member (Embed m) r => m a -> Sem r a
runConsoleIO ::
Member (Embed IO) r
=> Sem (Console ': r) a -> Sem r a
runConsoleIO = interpret $ \case
PrintLine line -> embed $ putStrLn line
ReadLine -> embed $ getLine
© Pawel Szulc, @EncodePanda, [email protected] 231
Slide 232
Slide 232 text
data Random v m a where
NextRandom :: Random v m v
runRandomIO ::
Member (Embed IO) r
=> Sem (Random Int ': r) a -> Sem r a
runRandomIO = interpret $ \case
NextRandom -> embed randomIO
© Pawel Szulc, @EncodePanda, [email protected] 232
Slide 233
Slide 233 text
data Random v m a where
NextRandom :: Random v m v
runRandomIO ::
Member (Embed IO) r
=> Sem (Random Int ': r) a -> Sem r a
runRandomIO = interpret $ \case
NextRandom -> embed randomIO
© Pawel Szulc, @EncodePanda, [email protected] 233
Slide 234
Slide 234 text
main :: IO ()
main = execute >>= putStrLn.show
where
execute = program
& runConsoleIO
& runRandomIO
& runM
© Pawel Szulc, @EncodePanda, [email protected] 234
Slide 235
Slide 235 text
main :: IO ()
main = execute >>= putStrLn.show
where
execute = program -- Sem '[Console, Random Int ] Int
& runConsoleIO
& runRandomIO
& runM
© Pawel Szulc, @EncodePanda, [email protected] 235
Slide 236
Slide 236 text
main :: IO ()
main = execute >>= putStrLn.show
where
execute = program -- Sem '[Console, Random Int ] Int
& runConsoleIO -- Sem '[ , Random Int, Embed IO] Int
& runRandomIO
& runM
© Pawel Szulc, @EncodePanda, [email protected] 236
Slide 237
Slide 237 text
main :: IO ()
main = execute >>= putStrLn.show
where
execute = program -- Sem '[Console, Random Int ] Int
& runConsoleIO -- Sem '[ , Random Int, Embed IO] Int
& runRandomIO -- Sem '[ , Embed IO] Int
& runM
© Pawel Szulc, @EncodePanda, [email protected] 237
Slide 238
Slide 238 text
main :: IO ()
main = execute >>= putStrLn.show
where
execute = program -- Sem '[Console, Random Int ] Int
& runConsoleIO -- Sem '[ , Random Int, Embed IO] Int
& runRandomIO -- Sem '[ , Embed IO] Int
& runM -- IO Int
© Pawel Szulc, @EncodePanda, [email protected] 238
Slide 240
Slide 240 text
data Invoice = Invoice
{ invoiceNumber :: InvoiceNumber
, fullName :: FullName
, deliveryAddress :: Address
, total :: Cent
}
© Pawel Szulc, @EncodePanda, [email protected] 240
Slide 241
Slide 241 text
newtype InvoiceNumber = InvoiceNumber { unInvoiceNumber :: Text }
deriving (Show, Eq)
data Address = Address
{ street :: Text
, house :: Text
, num :: Text
, city :: Text
, country :: Text
}
data FullName = FullName
{ first :: Text
, last :: Text
}
© Pawel Szulc, @EncodePanda, [email protected] 241
Slide 242
Slide 242 text
data Invoice = Invoice
{ invoiceNumber :: InvoiceNumber
, fullName :: FullName
, deliveryAddress :: Address
, total :: Cent
}
© Pawel Szulc, @EncodePanda, [email protected] 242
Slide 243
Slide 243 text
data CallType = Voice | Sms
newtype Duration = Duration { unDuration :: Int }
deriving stock (Show, Eq)
deriving newtype (Num)
data Cdr = Cdr
{ uuid :: UUID
, accountId :: AccountId
, callType :: CallType
, callDuration :: Duration
}
© Pawel Szulc, @EncodePanda, [email protected] 243
Slide 244
Slide 244 text
data Plan = Plan
{ voiceCost :: Cent
, smsCost :: Cent
}
data Profile = Profile
{ firstName :: Text
, lastName :: Text
, address :: Address
, plan :: Plan
}
© Pawel Szulc, @EncodePanda, [email protected] 244
Slide 245
Slide 245 text
mkInvoice ::
InvoiceNumber
-> Profile
-> [Cdr]
-> Invoice
mkInvoice invNum Profile {..} cdrs = Invoice
{ invoiceNumber = invNum
, fullName = FullName firstName lastName
, deliveryAddress= address
, total = foldr cost zeroCents cdrs
}
where
cost (Cdr _ _ Voice (Duration duration)) acc = acc + (voiceCost plan * duration)
cost (Cdr _ _ Sms (Duration amount)) acc = acc + (smsCost plan * amount)
© Pawel Szulc, @EncodePanda, [email protected] 245
Slide 246
Slide 246 text
mkInvoice ::
InvoiceNumber
-> Profile
-> [Cdr]
-> Invoice
mkInvoice = ...
© Pawel Szulc, @EncodePanda, [email protected] 246
Slide 250
Slide 250 text
import Polysemy
data Crm m a where
GetProfile :: AccountId -> Crm m Profile
makeSem ''Crm
© Pawel Szulc, @EncodePanda, [email protected] 250
Slide 254
Slide 254 text
import Polysemy
data CdrStore m a where
FetchCdrs :: AccountId -> CdrStore m [Cdr]
makeSem ''CdrStore
© Pawel Szulc, @EncodePanda, [email protected] 254
Slide 258
Slide 258 text
import Polysemy
data InvoiceStore m a where
GenNextInvoiceNumber :: AccountId -> InvoiceStore m InvoiceNumber
makeSem ''InvoiceStore
© Pawel Szulc, @EncodePanda, [email protected] 258
Slide 262
Slide 262 text
import Polysemy
data InvoiceStore m a where
GenNextInvoiceNumber :: AccountId -> InvoiceStore m InvoiceNumber
makeSem ''InvoiceStore
© Pawel Szulc, @EncodePanda, [email protected] 262
Slide 263
Slide 263 text
import Polysemy
data InvoiceStore m a where
GenNextInvoiceNumber :: AccountId -> InvoiceStore m InvoiceNumber
StoreInvoice :: AccountId -> Invoice -> InvoiceStore m ()
makeSem ''InvoiceStore
© Pawel Szulc, @EncodePanda, [email protected] 263
Slide 266
Slide 266 text
generateInvoice ::
Member CdrStore r
=> Member Crm r
=> Member InvoiceStore r
=> AccountId
-> Sem r Invoice
generateInvoice accId = do
invNumber <- genNextInvoiceNumber accId
profile <- getProfile accId
cdrs <- fetchCdrs accId
let invoice = mkInvoice invNumber profile cdrs
storeInvoice accId invoice
return invoice
© Pawel Szulc, @EncodePanda, [email protected] 266
Slide 267
Slide 267 text
data Crm m a where
GetProfile :: AccountId -> Crm m Profile
type CrmMap = M.Map AccountId Profile
runCrm ::
Member (State CrmMap) r
=> Sem (Crm ': r) a
-> Sem r a
runCrm = interpret $ \case
GetProfile accountId -> gets (\m -> m M.! accountId)
© Pawel Szulc, @EncodePanda, [email protected] 267
Slide 268
Slide 268 text
data CdrStore m a where
FetchCdrs :: AccountId -> CdrStore m [Cdr]
type CdrMap = M.Map AccountId [Cdr]
runCdrStore ::
Member (State CdrMap) r
=> Sem (CdrStore ': r) a
-> Sem r a
runCdrStore = interpret $ \case
FetchCdrs accountId -> gets (\m -> m M.! accountId)
© Pawel Szulc, @EncodePanda, [email protected] 268
Slide 269
Slide 269 text
data InvoiceStore m a where
StoreInvoice :: AccountId -> Invoice -> InvoiceStore m ()
GenNextInvoiceNumber :: AccountId -> InvoiceStore m InvoiceNumber
type InvoiceMap = M.Map (AccountId, InvoiceNumber) Invoice
runInvoiceStore ::
Member (State InvoiceMap) r
=> Member (Embed IO) r
=> Sem (InvoiceStore ': r) a
-> Sem r a
runInvoiceStore = interpret $ \case
StoreInvoice accountId invoice ->
modify (M.insert (accountId, invoiceNumber invoice) invoice)
GenNextInvoiceNumber accountId ->
embed $ fmap (InvoiceNumber . toText) nextRandom
© Pawel Szulc, @EncodePanda, [email protected] 269
Slide 270
Slide 270 text
main :: IO ()
main = execute
where
accountId = AccountId 1000
execute = generateInvoice accountId
& runCrm
& runCdrStore
& runInvoiceStore
& evalState @CrmMap (M.singleton accountId profile)
& evalState @CdrMap (M.singleton accountId (cdrs accountId))
& evalState @InvoiceMap M.empty
& runM
© Pawel Szulc, @EncodePanda, [email protected] 270
Slide 271
Slide 271 text
main :: IO ()
main = execute
where
accountId = AccountId 1000
execute = generateInvoice accountId
& runCrm
& runCdrStore
& runInvoiceStore
& evalState @CrmMap (M.singleton accountId profile)
& evalState @CdrMap (M.singleton accountId (cdrs accountId))
& evalState @InvoiceMap M.empty
& runM
© Pawel Szulc, @EncodePanda, [email protected] 271
Slide 272
Slide 272 text
main :: IO ()
main = execute
where
accountId = AccountId 1000
execute = generateInvoice accountId
& runCrm
& runCdrStore
& runInvoiceStore
& evalState @CrmMap (M.singleton accountId profile)
& evalState @CdrMap (M.singleton accountId (cdrs accountId))
& evalState @InvoiceMap M.empty
& runM
© Pawel Szulc, @EncodePanda, [email protected] 272
Slide 273
Slide 273 text
main :: IO ()
main = execute
where
accountId = AccountId 1000
execute = generateInvoice accountId
& runCrm
& runCdrStore
& runInvoiceStore
& evalState @CrmMap (M.singleton accountId profile)
& evalState @CdrMap (M.singleton accountId (cdrs accountId))
& evalState @InvoiceMap M.empty
& runM
© Pawel Szulc, @EncodePanda, [email protected] 273
Slide 274
Slide 274 text
main :: IO ()
main = execute
where
accountId = AccountId 1000
execute = generateInvoice accountId
& runCrm
& runCdrStore
& runInvoiceStore
& evalState @CrmMap (M.singleton accountId profile)
& evalState @CdrMap (M.singleton accountId (cdrs accountId))
& evalState @InvoiceMap M.empty
& runM
© Pawel Szulc, @EncodePanda, [email protected] 274
Slide 275
Slide 275 text
profile :: Profile
profile = Profile "John" "Smith" address plan
where
address =
Address "Backer Street" "221b" "2" "London" "United Kingdom"
plan = Plan 10 1
© Pawel Szulc, @EncodePanda, [email protected] 275
Slide 276
Slide 276 text
main :: IO ()
main = execute
where
accountId = AccountId 1000
execute = generateInvoice accountId
& runCrm
& runCdrStore
& runInvoiceStore
& evalState @CrmMap (M.singleton accountId profile)
& evalState @CdrMap (M.singleton accountId (cdrs accountId))
& evalState @InvoiceMap M.empty
& runM
© Pawel Szulc, @EncodePanda, [email protected] 276
Slide 277
Slide 277 text
main :: IO ()
main = execute
where
accountId = AccountId 1000
execute = generateInvoice accountId
& runCrm
& runCdrStore
& runInvoiceStore
& evalState @CrmMap (M.singleton accountId profile)
& evalState @CdrMap (M.singleton accountId (cdrs accountId))
& evalState @InvoiceMap M.empty
& runM
© Pawel Szulc, @EncodePanda, [email protected] 277
Slide 278
Slide 278 text
cdrs :: AccountId -> [Cdr]
cdrs accountId =
[ cdr "8abbe08f-4b64-4263-b000-13f3ff77a0c6" Voice 10
, cdr "bed067b0-3e79-429d-8b96-d1f2c96e79ba" Sms 1
, cdr "d4bea3d9-a2a7-44cc-8a8d-301051860761" Voice 30
]
© Pawel Szulc, @EncodePanda, [email protected] 278
Slide 279
Slide 279 text
main :: IO ()
main = execute
where
accountId = AccountId 1000
execute = generateInvoice accountId
& runCrm
& runCdrStore
& runInvoiceStore
& evalState @CrmMap (M.singleton accountId profile)
& evalState @CdrMap (M.singleton accountId (cdrs accountId))
& evalState @InvoiceMap M.empty
& runM
© Pawel Szulc, @EncodePanda, [email protected] 279
Slide 280
Slide 280 text
main :: IO ()
main = execute
where
accountId = AccountId 1000
execute = generateInvoice accountId
& runCrm
& runCdrStore
& runInvoiceStore
& evalState @CrmMap (M.singleton accountId profile)
& evalState @CdrMap (M.singleton accountId (cdrs accountId))
& evalState @InvoiceMap M.empty
& runM
© Pawel Szulc, @EncodePanda, [email protected] 280
Slide 281
Slide 281 text
main :: IO ()
main = execute
where
accountId = AccountId 1000
execute = generateInvoice accountId
& runCrm
& runCdrStore
& runInvoiceStore
& evalState @CrmMap (M.singleton accountId profile)
& evalState @CdrMap (M.singleton accountId (cdrs accountId))
& evalState @InvoiceMap M.empty
& runM
© Pawel Szulc, @EncodePanda, [email protected] 281
Slide 282
Slide 282 text
main :: IO ()
main = execute
where
accountId = AccountId 1000
execute = generateInvoice accountId
& runCrm
& runCdrStore
& runInvoiceStore
& evalState @CrmMap (M.singleton accountId profile)
& evalState @CdrMap (M.singleton accountId (cdrs accountId))
& evalState @InvoiceMap M.empty
& runM
© Pawel Szulc, @EncodePanda, [email protected] 282
Slide 283
Slide 283 text
main :: IO ()
main = execute >>= putStrLn.prettyPrint
where
accountId = AccountId 1000
execute = generateInvoice accountId
& runCrm
& runCdrStore
& runInvoiceStore
& evalState @CrmMap (M.singleton accountId profile)
& evalState @CdrMap (M.singleton accountId (cdrs accountId))
& evalState @InvoiceMap M.empty
& runM
prettyPrint = unpack.toStrict.encodePretty
© Pawel Szulc, @EncodePanda, [email protected] 283
Slide 284
Slide 284 text
{
"fullName": {
"first": "John",
"last": "Smith"
},
"deliveryAddress": {
"country": "United Kingdom",
"num": "2",
"street": "Backer Street",
"house": "221b",
"city": "London"
},
"invoiceNumber": "136172ef-95cb-4714-924a-4d3f9c5e5fd6",
"total": 401
}
© Pawel Szulc, @EncodePanda, [email protected] 284
Slide 286
Slide 286 text
Thank You!
Pawel Szulc
twi$er: @EncodePanda
email: [email protected]
© Pawel Szulc, @EncodePanda, [email protected] 286