Painless Haskell

Painless Haskell
"This is a journey into sound.
A journey which along the way will bring to you magic ..."
sound [adjective]
- free from error, fallacy, or misapprehension
- exhibiting or based on thorough knowledge and experience
- logically valid and having true premises
© Pawel Szulc, @rabbitonweb, paul.szulc@gmail.com 1

Any sufﬁciently advanced
technology is indistinguishable
from magic.
— Arthur C. Clarke

The Roadmap
— aeson
— optparse-generic
— servant
— polysemy
!

Tools
— aeson

Tools
— aeson
A JSON parsing and encoding library optimized for ease of use
and high performance.

How to get latest currency exchange rates?
https://api.exchangeratesapi.io/latest?base=EUR
{
"rates": {
"CHF": 1.0948,
"PLN": 4.3183,
"USD": 1.103,
"GBP": 0.90155
},
"base": "EUR",
"date": "2019-10-10"
}

{
"rates": {
"CHF": 1.0948,
"PLN": 4.3183,
"USD": 1.103,
"GBP": 0.90155
},
"base": "EUR",
"date": "2019-10-10"
}
data RatesResult = RatesResult {
rates :: M.Map String Double
, base :: String
, date :: String
}

{
"rates": {
"CHF": 1.0948,
"PLN": 4.3183,
"USD": 1.103,
"GBP": 0.90155
},
"base": "EUR",
"date": "2019-10-10"
}
, base :: String
, date :: String
}

Magic

, base :: String
, date :: String
}
encodeExample :: IO ()
encodeExample = do
let rates = M.singleton "GBP" 1.12
let ratesResult = RatesResult rates "EUR" "2019-10-10"
let json = encode ratesResult
putStrLn json
λ> encodeExample
{"base":"EUR","rates":{"GBP":1.12},"date":"2019-10-10"}

, base :: String
, date :: String
}
encodeExample = do
putStrLn json
λ> encodeExample

Science

{-# LANGUAGE DeriveGeneric #-}
import Data.Aeson
import GHC.Generics
, base :: String
, date :: String
}
instance ToJSON RatesResult

import Data.Aeson
import GHC.Generics
, base :: String
, date :: String
}

import Data.Aeson
import GHC.Generics
, base :: String
, date :: String
} deriving (Generic, Show)

import Data.Aeson
import GHC.Generics
, base :: String
, date :: String

rates.json
{
"base": "EUR",
"rates": {
"CHF": 1.0948,
"PLN": 4.3183,
"USD": 1.103,
"GBP": 0.90155
},
"date": "2019-10-10"
}

, base :: String
, date :: String
decodeExample :: IO ()
decodeExample = do
raw <- readFile "rates.json"
putStrLn $ extract $ decode raw
where
extract (Just (RatesResult _ base _)) = base
extract Nothing = "nothing"
λ> decodeExample
EUR

, base :: String
, date :: String
decodeExample = do
where
λ> decodeExample
EUR

import Data.Aeson
import GHC.Generics
, base :: String
, date :: String

import Data.Aeson
import GHC.Generics
, base :: String
, date :: String
instance FromJSON RatesResult

Tools
— aeson

Tools
— aeson
This library auto-generates command-line parsers for data
types using Haskell's built-in support for generic programming.

What does it take to create a confernece?
You need to ﬁgure out the follwing:
— name
— number of attendees
— ticket price

create :: String -> Int -> Double -> IO ()
create name capacity price =
putStrLn $ "Conference "
++ name
++ " for "
++ (show capacity)
++ " people created! Join now, just for "
++ (show price)
++ " EUR"
λ create "Lambda World" 650 150.0
Conference Lambda World for 650 people created! Join now, just for 150.0 EUR

create :: String -> Int -> Double -> IO ()
create name capacity price =
putStrLn $ "Conference "
++ name
++ " for "
++ (show capacity)
++ " people created! Join now, just for "
++ (show price)
++ " EUR"
λ create "Lambda World" 650 150.0

main :: IO ()
main = do
[name, capacity, price] <- getArgs
create name capacity price

main :: IO ()
main = do

main :: IO ()
main = do
• Couldn't match type
Expected type: Int
Actual type: String
• In the second argument of ‘create’, namely ‘capacity’
|
30 | create name capacity price
| ^^^^^^^^

main :: IO ()
main = do

main :: IO ()
main = do
create name (read capacity) (read price)

main :: IO ()
main = do
$> creator "Lambda World" 650 150

main :: IO ()
main = do
$> creator "Lambda World" 650
program: user error (Pattern match failure in do expression at src/Example.hs:29:3-25)

main :: IO ()
main = do
$> creator "Lambda World" 650
program: user error (Pattern match failure in do expression at src/Example.hs:29:3-25)
$> creator "Lambda World" 650.0 150
program: Prelude.read: no parse

Magic

data Conference = Conference {
name :: String
, capacity :: Int
, price :: Double
}
main :: IO ()
main = do
(Conference name capacity price) <- getRecord "Conference creator"

name :: String
, capacity :: Int
, price :: Double
}
main :: IO ()
main = do
(Conference name capacity price) <- getRecord "Conference creator"

$> creator --name "Lambda World" --capacity 650 --price 150
$> creator --name "Lambda World" --capacity 650
Missing: --price DOUBLE
Usage: program --name STRING --capacity INT --price DOUBLE
$> creator --help
Conference creator
Available options:
-h,--help Show this help text

$> creator --help
Conference creator
Available options:

Science

import Options.Generic
name :: String
, capacity :: Int
, price :: Double
}
instance ParseRecord Conference

name :: String
, capacity :: Int
, price :: Double
}

name :: String
, capacity :: Int
, price :: Double

A bit more Magic

name :: String
, capacity :: Int
, price :: Double
$> creator --help
Conference creator
Available options:
--name STRING Name of the conference
--capacity INT Capacity of the venue
--price DOUBLE Price of the single ticket

name :: String <?> "Name of the conference"
, capacity :: Int <?> "Capacity of the venue"
, price :: Double <?> "Price of the single ticket"
$> creator --help
Conference creator
Available options:

$> creator --help
Conference creator
Available options:

Tools
— aeson

Tools
— aeson
— servant

Tools
— aeson
— servant
servant is a set of packages for declaring web APIs at the type-
level and then using those API speciﬁcations to: write servers,
obtain client functions, generate documentation and more...

So!ware Apocalypse 1
1
The Coming Software Apocalypse
A small group of programmers wants to change how we code — before catastrophe strikes.
website.

Plan B

data Color = White | Beige | Brown | Black | Silver
deriving (Generic, Show)
data Alpaca = Alpaca {
name :: String
, color :: Color
, age :: Int
instance ToJSON Color
instance FromJSON Color
instance ToJSON Alpaca
instance FromJSON Alpaca

name :: String
, color :: Color
, age :: Int

— /alpaca GET
Response: {"1":{"color":"White","age":0,"name":"Dotty"}}, 200
— /alpaca/1 GET
Response: {"color":"White","age":0,"name":"Dotty"}, 200
— /alpaca/1 PUT
Body: {"color":"White","age":0,"name":"Dotty"}
Response: NoContent, 201

Magic

import Servant
type AlpacaAPI =
"alapaca" :> Get '[JSON] (M.Map Int Alpaca)
:<|> "alapaca" :> Capture "alpacaId" Int :> Get '[JSON] Alpaca
:<|> "alapaca" :> Capture "alpacaId" Int
:> ReqBody '[JSON] Alpaca
:> PutCreated '[JSON] NoContent

import Servant
type AlpacaAPI =
/alpaca GET
Response: {"1":{"color":"White","age":0,"name":"Dotty"}}, 200

import Servant
type AlpacaAPI =
/alpaca/1 GET
Response: {"color":"White","age":0,"name":"Dotty"}, 200

import Servant
type AlpacaAPI =
/alpaca/1 PUT
Body: {"color":"White","age":0,"name":"Dotty"}
Response: NoContent, 201

import Servant
type AlpacaAPI =

import Servant
type AlpacaAPI =
-- data Proxy a = Proxy
alpacaApi :: Proxy AlpacaAPI
alpacaApi = Proxy

import Servant
type AlpacaAPI =
-- data Proxy a = Proxy
alpacaApi = Proxy

Magic

Generating client functions

type AlpacaAPI =
alpacaApi = Proxy
-- client functions
getAll :: m (Data.Map.Internal.Map Int Alpaca)
getAlpaca :: Int -> m Alpaca
putAlpaca :: Int -> Alpaca -> m NoContent

type AlpacaAPI =
alpacaApi = Proxy
-- client functions

type AlpacaAPI =
alpacaApi = Proxy
-- client functions
import Servant.Client

type AlpacaAPI =
alpacaApi = Proxy
-- client functions
client alpacaApi

type AlpacaAPI =
alpacaApi = Proxy
-- client functions
getAll :<|> getAlpaca :<|> putAlpaca = client alpacaApi

addNew :: Int -> String -> ClientM Alpaca
addNew id name = do
let alpaca = Alpaca name White 0
putAlpaca id alpaca
getAlpaca id
main :: IO ()
main = do
let baseUrl = (BaseUrl Http "localhost" 8080 "")
manager' <- newManager defaultManagerSettings
let clientEnv = mkClientEnv manager' baseUrl
res <- runClientM (addNew 1 "Reksio") clientEnv
case res of
Left err -> putStrLn $ "Error: " ++ show err
Right alpaca -> putStrLn $ show alpaca

addNew id name = do
putAlpaca id alpaca
getAlpaca id
main :: IO ()
main = do
case res of

type AlpacaAPI =

Generating documentation

type AlpacaAPI =
instance ToCapture (Capture 'alpacaId' Int) where
toCapture _ =
DocCapture "alpacaId"
"An id that uniquely identifies an alpaca in the system"
instance ToSample (Alpaca) where
toSamples _ = singleSample $ Alpaca "Dotty" White 0
instance ToSample (M.Map Int Alpaca) where
toSamples _ = singleSample $ M.singleton 1 (Alpaca "Dotty" White 0)

type AlpacaAPI =
toCapture _ =

type AlpacaAPI =
alpacaApi = Proxy
import Servant.Docs
apiDocs :: API
apiDocs = docs alpacaApi
main :: IO ()
main = (writeFile "docs.md" . markdown) apiDocs

type AlpacaAPI =
alpacaApi = Proxy
import Servant.Docs
apiDocs :: API
main :: IO ()

type AlpacaAPI =

Actually writing the server

type AlpacaAPI =
fetchAll :: Monad m => m (M.Map Int Alpaca)
fetchAll = pure $ M.singleton 1 dummy
fetch :: Monad m => Int -> m Alpaca
fetch id = pure dummy
insert :: Monad m => Int -> Alpaca -> m NoContent
insert id alpaca = pure NoContent

type AlpacaAPI =

server :: Server AlpacaAPI
server =
fetchAll
:<|> fetch
:<|> insert

server =
fetchAll
:<|> fetch
:<|> insert

server =
fetchAll
:<|> fetch
--:<|> insert

server =
fetchAll
:<|> fetch
--:<|> insert
Example.hs:29:8: error:
(...)
Expected type: Server AlpacaAPI
Actual type: Handler (M.Map Int Alpaca) :<|> (Int -> m0 Alpaca)
(...)

server =
fetchAll
:<|> fetch
:<|> insert
app :: Application
app = serve alpacaApi server
main :: IO ()
main = run 8080 app

server =
fetchAll
:<|> fetch
:<|> insert
app :: Application
main :: IO ()
main = run 8080 app

Tools
— aeson
— servant

Tools
— aeson
— servant
— polysemy

Tools
— aeson
— servant
— polysemy
!

Tools
— aeson
— servant
— polysemy
polysemy is a library for writing high-power, low-boilerplate,
zero-cost, domain speciﬁc languages. It allows you to separate
your business logic from your implementation details.

Tools
— aeson
— servant
— polysemy
And in doing so, polysemy lets you turn your implementation
code into reusable library code.

Sem r a.
program :: Sem '[Console, (Random Int)] Int

Sem r a.

Sem r a___
___
.________________________________________^

Sem r a.

Sem r a________________________
________________________
.________________________^

Sem r a.

Sem r aprogram ::
Member Console r
=> Member (Random Int) r
=> Sem r Int
.

Sem r aprogram ::
Member Console r
=> Sem r Int
.________^

Sem r aprogram ::
Member Console r <|
=> Member (Random Int) r <|
=> Sem r Int |
.________^_____________________|

program ::
Member Console 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

program ::
Member Console r
=> Sem r Int
makeSem ''Console

program ::
Member Console 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

program ::
Member Console r
=> Sem r Int
makeSem ''Random

-- cheatsheet
program ::
Member Console r
=> Sem r Int
program = do
printLine "Insert your number:"
i1 <- readLine
i2 <- nextRandom
pure (read i1 + i2)

-- cheatsheet
program ::
Member Console r
=> Sem r Int
program = do
i1 <- readLine
i2 <- nextRandom
pure (read i1 + i2)

program ::
Member Console r
=> Sem r Int
program = do
i1 <- readLine
i2 <- nextRandom
pure (read i1 + i2)
-- Sem r a ~> IO a ?

run :: Sem '[] a -> a
runM :: Monad m
=> Sem '[Embed m] a -> m a
-- Sem '[Embed IO] a -> IO a
program ::
Member Console r
=> Sem r Int
-- Sem '[Console, Random Int] Int

run :: Sem '[] a -> a
runM :: Monad m
program ::
Member Console r
=> Sem r Int

What we need is an interpreter

runConsoleIO ::
Member (Embed IO) r
=> Sem (Console ': r) a -> Sem r a
runConsoleIO = interpret $ case
PrintLine line -> putStrLn line
ReadLine -> getLine

runConsoleIO ::
Member (Embed IO) r
ReadLine -> getLine

-- embed :: Member (Embed m) r => m a -> Sem r a
runConsoleIO ::
Member (Embed IO) r
ReadLine -> getLine

-- embed :: Member (Embed m) r => m a -> Sem r a
runConsoleIO ::
Member (Embed IO) r
PrintLine line -> embed $ putStrLn line
ReadLine -> embed $ getLine

runRandomIO ::
Member (Embed IO) r
=> Sem (Random Int ': r) a -> Sem r a
runRandomIO = interpret $ case
NextRandom -> embed randomIO

main :: IO ()
main = execute >>= putStrLn.show
where
execute = program
& runConsoleIO
& runRandomIO
& runM

main :: IO ()
where
execute = program -- Sem '[Console, Random Int ] Int
& runConsoleIO
& runRandomIO
& runM

main :: IO ()
where
& runConsoleIO -- Sem '[ , Random Int, Embed IO] Int
& runRandomIO
& runM

main :: IO ()
where
& runRandomIO -- Sem '[ , Embed IO] Int
& runM

main :: IO ()
where
& runRandomIO -- Sem '[ , Embed IO] Int
& runM -- IO Int

Can we write unit tests for this program?
program ::
Member Console r
=> Sem r Int
program = do
i1 <- readLine
i2 <- nextRandom
pure (read i1 + i2)

program ::
Member Console r
=> Sem r Int
program = do
i1 <- readLine
i2 <- nextRandom
pure (read i1 + i2)

runRandomConst :: Int -> Sem (Random Int ': r) a -> Sem r a
runRandomConst v = interpret $ case
NextRandom -> pure v
runConsoleConst :: String -> Sem (Console ': r) a -> Sem r a
runConsoleConst constLine = interpret $ case
PrintLine line -> pure ()
ReadLine -> pure constLine

spec :: Spec
spec =
describe "program" $ do
it "can add two numbers together (random and from console)" $ do
let result = program
& runConsoleConst "10"
& runRandomConst 20
& run
result `shouldBe` 30

spec :: Spec
spec =
let result = program
& runRandomConst 20
& run

spec :: Spec
spec =
let result = program -- Sem '[Console, Random Int] Int
& runRandomConst 20
& run

spec :: Spec
spec =
& runConsoleConst "10"-- Sem '[ Random Int] Int
& runRandomConst 20
& run

spec :: Spec
spec =
& runRandomConst 20 -- Sem '[ ] Int
& run

spec :: Spec
spec =
& run -- Int

Typelevel Programming
Magic vs Science

Typelevel Programming: Magic vs Science
— https://leanpub.com/thinking-with-types

— https://www.parsonsmatt.org/2017/04/26/
basic_type_level_programming_in_haskell.html

— https://www.parsonsmatt.org/2017/04/26/
basic_type_level_programming_in_haskell.html
— https://github.com/tdietert/types-as-speciﬁcations

What was the point of all this?

Homework: Write an application
that combines aeson, optparse-
generic, servant and polysemy

Polysemy - where can I learn
more?

Polysemy - where can I learn more?
— Lets hack your homework together

— Prerequisites: hangouts, craft beer, haskell

— https://github.com/rabbitonweb/todo-rest

— https://github.com/rabbitonweb/todo-rest
— https://github.com/frost-org/frost

Polysemy: conquer complexity

Polysemy vs MTL/Tagless vs ...

And The Sopranos is the show I recommend

Because you never really know how it's gonna

Next year? :)

Pawel Szulc
twi!er: @rabbitonweb
email: paul.szulc@gmail.com
blog: https://rabbitonweb.com

Painless Haskell

More Related Content

Similar to Painless Haskell (10)

More from Pawel Szulc (20)

Recently uploaded (20)

Painless Haskell