Skip to content

Instantly share code, notes, and snippets.

@leighman
Forked from oxbowlakes/3nightclubs.scala
Last active April 9, 2023 18:21
Show Gist options
  • Save leighman/d61dc7e0e96ea4cebb5a2c960e3c64fa to your computer and use it in GitHub Desktop.
Save leighman/d61dc7e0e96ea4cebb5a2c960e3c64fa to your computer and use it in GitHub Desktop.
A Tale of 3 Nightclubs
{
"name": "3-nightclubs",
"ignore": [
"**/.*",
"node_modules",
"bower_components",
"output"
],
"dependencies": {
"purescript-prelude": "^2.4.0",
"purescript-console": "^2.0.0",
"purescript-sets": "^2.0.1",
"purescript-validation": "^2.0.0",
"purescript-integers": "^2.1.1"
},
"devDependencies": {
"purescript-psci-support": "^2.0.0"
}
}
module Main where
import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, logShow)
import Data.Either (Either(..))
import Data.Foldable (elem, notElem)
import Data.Int (toNumber)
import Data.Traversable (traverse)
import Data.Validation.Semigroup (invalid)
{-
- Act Zero: 10:15 Saturday Night
-
- In which we will see how to use the type system to handle failure
- with the Either type and the V (Validation) type.
-}
data Sobriety = Sober | Tipsy | Drunk | Paralytic | Unconscious
derive instance eqSobriety :: Eq Sobriety
data Gender = Male | Female
derive instance eqGender :: Eq Gender
type Person =
{ gender :: Gender
, age :: Int
, clothes :: Array String
, sobriety :: Sobriety
}
mkPerson :: Gender -> Int -> Array String -> Sobriety -> Person
mkPerson gender age clothes sobriety = {gender, age, clothes, sobriety}
{-
- Here we define some checks that all nightclubs make.
-
- The checks can be specialised by providing a function that
- creates the error case. For Either this is `Left` and for V this
- is `invalid`.
-}
checkAge :: forall m. Applicative m => (Array String -> m Person) -> Person -> m Person
checkAge bad p
| p.age < 18 = bad ["Too Young!"]
| p.age > 40 = bad ["Too Old!"]
| otherwise = pure p
checkClothes :: forall m. Applicative m => (Array String -> m Person) -> Person -> m Person
checkClothes bad p
| p.gender == Male && "Tie" `notElem` p.clothes = bad ["Smarten Up!"]
| p.gender == Female && "Trainers" `elem` p.clothes = bad ["Wear high heels"]
| otherwise = pure p
checkSobriety :: forall m. Applicative m => (Array String -> m Person) -> Person -> m Person
checkSobriety bad p =
if p.sobriety `elem` [Drunk, Paralytic, Unconscious]
then bad ["Sober Up!"]
else pure p
main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do
{-
- Act One
-
- First we can perform some checks using the monadic `do` syntax
-
- In PureScript the V type does not implement the Bind class
- required for `do` but we can use the Either type with `Left`
- signifying failure.
-
- Because we are using Bind the checks are *fail-fast*. That is,
- any failed check shortcircuits subsequent checks so even though
- we are returning the error as an Array String we will only ever
- get one error.
-}
let
checkAge' = checkAge Left
checkClothes' = checkClothes Left
checkSobriety' = checkSobriety Left
costToEnter p = do
a <- checkAge' p
b <- checkClothes' a
c <- checkSobriety' b
pure if p.gender == Female then 0.0 else 5.0
ken = mkPerson Male 28 ["Tie", "Shirt"] Tipsy
dave = mkPerson Male 41 ["Tie", "Jeans"] Sober
ruby = mkPerson Female 25 ["High Heels"] Tipsy
logShow $ costToEnter dave -- (Left ["Too Old!"])
logShow $ costToEnter ken -- (Right 5.0)
logShow $ costToEnter ruby -- (Right 0.0)
logShow $ costToEnter ruby {age = 17} -- (Left ["Too Young!"])
logShow $ costToEnter ken {sobriety = Unconscious} -- (Left ["Sober Up!"])
{-
- Act Two
-
- An ideal nightclub would instead tell us *everything* that is wrong.
-
- Applicative functors and V to the rescue!
-
- This time we can use the V type to accumulate all errors via a
- Semigroup structure such as Array.
-}
let
validateAge = checkAge invalid
validateClothes = checkClothes invalid
validateSobriety = checkSobriety invalid
costToEnter2 p =
price <$>
validateAge p <*> validateClothes p <*> validateSobriety p
where
price _ _ _ = if p.gender == Female then 0.0 else 7.5
logShow $ costToEnter2 dave {sobriety = Paralytic} -- (Invalid ["Too Old!","Sober Up!"])
logShow $ costToEnter2 ruby -- (Valid 0.0)
{-
- Act Three
-
- As you can see above, collecting results from a large number of
- checks can get messy.
-
- To make a large number of checks we can `traverse` over the checks.
-}
let
validateGender p =
if p.gender /= Male then invalid ["Men Only"] else pure p
checks =
[ validateAge
, validateClothes
, validateSobriety
, validateGender
]
costToEnter3 p =
price <$> traverse ((#) p) checks
where
price _ = (toNumber p.age) + 1.5
bob = mkPerson Male 59 ["Jeans"] Paralytic
logShow $ costToEnter3 ken -- (Valid 29.5)
logShow $ costToEnter3 ruby -- (Invalid ["Men Only"])
logShow $ costToEnter3 bob -- (Invalid ["Too Old!","Smarten Up!","Sober Up!"])
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment