typestate.hs

#!/usr/bin/env nix-shell
#!nix-shell -i ghcid -p ghcid "ghc.withPackages (p: with p; [ linear-base ])"

-- Rough, imperfect re-implementation of this article on using Swift's
-- "typestate" pattern. Haskell fails to replicate some aspects, and exceeds
-- Swift's capabilities in other areas.
--
-- https://swiftology.io/articles/typestate/

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE OverloadedRecordDot #-}

module Typestate
  ( -- * v1
    TurnstileState1 (..)
  , Turnstile1
  , coins1
  , init1
  , insertCoin1
  , push1

    -- * v2
  , Locked2
  , Unlocked2
  , Turnstile2
  , coins2
  , init2
  , insertCoin2
  , push2

    -- * v3
  , Locked3
  , Unlocked3
  , Turnstile3
  , coins3
  , init3
  , insertCoin3
  , push3

    -- * v4
  , Locked4
  , Unlocked4
  , TurnstileState4
  , Turnstile4
  , coins4
  , init4
  , insertCoin4
  , push4
  , tsInit4
  , tsInsertCoin4
  , tsPush4

  -- * v5 (bonus weird GADT version for fun)
  , TurnstileState5 (..)
  , Turnstile5
  , coins5
  , init5
  , insertCoin5
  , push5
  )
where

import Prelude.Linear qualified as L
import Data.Kind (Type)
import Data.Int (Int)

data TurnstileState1
  = Locked1
  | Unlocked1
  deriving stock (Eq)

data Turnstile1 = Turnstile1
  { state :: TurnstileState1
  , coins :: Int
  }

coins1 :: Turnstile1 -> Int
coins1 turnstile = turnstile.coins

init1 :: Int -> Turnstile1
init1 coins =
  Turnstile1
    { state = Locked1
    , coins
    }

insertCoin1 :: Turnstile1 -> Turnstile1
insertCoin1 turnstile =
  if turnstile.state == Locked1 then
    turnstile
  else
    Turnstile1
      { state = Unlocked1
      , coins = turnstile.coins + 1
      }

push1 :: Turnstile1 -> Turnstile1
push1 turnstile = turnstile{ state = Locked1 }

--------------------------------------------------------------------------------

data Locked2

data Unlocked2

data Turnstile2 state = Turnstile2
  { coins :: Int
  }

coins2 :: Turnstile1 -> Int
coins2 turnstile = turnstile.coins

init2 :: Int -> Turnstile2 Locked2
init2 coins = Turnstile2{ coins }

insertCoin2 :: Turnstile2 Locked2 -> Turnstile2 Unlocked2
insertCoin2 turnstile = Turnstile2{ coins = turnstile.coins + 1 }

push2 :: Turnstile2 Unlocked2 -> Turnstile2 Locked2
push2 Turnstile2{ coins } = Turnstile2 { coins }

--------------------------------------------------------------------------------

data Locked3

data Unlocked3

data Turnstile3 state = Turnstile3
  { coins :: L.Int
  }

coins3 :: Turnstile1 -> Int
coins3 turnstile = turnstile.coins

init3 :: L.Int -> Turnstile3 Locked3
init3 coins = Turnstile3{ coins }

insertCoin3 :: Turnstile3 Locked3 %1 -> Turnstile3 Unlocked3
insertCoin3 Turnstile3{ coins } = Turnstile3{ coins = coins L.+ 1 }

push3 :: Turnstile3 Unlocked3 %1 -> Turnstile3 Locked3
push3 Turnstile3{ coins } = Turnstile3 { coins }

--------------------------------------------------------------------------------

data Locked4

data Unlocked4

data TurnstileState4
  = TSLocked4 (Turnstile4 Locked4)
  | TSUnlocked4 (Turnstile4 Unlocked4)

data Turnstile4 state = Turnstile4
  { coins :: L.Int
  }

coins4 :: Turnstile1 -> Int
coins4 turnstile = turnstile.coins

init4 :: L.Int -> Turnstile4 Locked4
init4 coins = Turnstile4{ coins }

insertCoin4 :: Turnstile4 Locked4 %1 -> Turnstile4 Unlocked4
insertCoin4 Turnstile4{ coins } = Turnstile4{ coins = coins L.+ 1 }

push4 :: Turnstile4 Unlocked4 %1 -> Turnstile4 Locked4
push4 Turnstile4{ coins } = Turnstile4 { coins }

tsInit4 :: L.Int -> TurnstileState4
tsInit4 coins = TSLocked4 (init4 coins)

tsInsertCoin4 :: TurnstileState4 -> TurnstileState4
tsInsertCoin4 = \case
  TSLocked4 locked -> TSUnlocked4 (insertCoin4 locked)
  TSUnlocked4 unlocked -> TSUnlocked4 unlocked

tsPush4 :: TurnstileState4 -> TurnstileState4
tsPush4 = \case
  TSLocked4 locked -> TSLocked4 locked
  TSUnlocked4 unlocked -> TSLocked4 (push4 unlocked)

--------------------------------------------------------------------------------

data TurnstileState5
  = Locked5
  | Unlocked5

type Turnstile5 :: TurnstileState5 -> Type
data Turnstile5 state where
  Init5 :: Int -> Turnstile5 Locked5
  InsertCoin5 :: Turnstile5 Locked5 %1 -> Turnstile5 Unlocked5
  Push5 :: Turnstile5 Unlocked5 %1 -> Turnstile5 Locked5

-- lol
coins5 :: Turnstile5 state -> Int
coins5 = \case
  Init5 n -> n
  InsertCoin5 prev -> 1 + coins5 prev
  Push5 prev -> coins5 prev

init5 :: Int -> Turnstile5 Locked5
init5 = Init5

insertCoin5 :: Turnstile5 Locked5 %1 -> Turnstile5 Unlocked5
insertCoin5 = InsertCoin5

push5 :: Turnstile5 Unlocked5 %1 -> Turnstile5 Locked5
push5 = Push5