A Tale of 3 Nightclubs

bower.json

{
  "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"
  }
}

Main.purs

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!"])