haskell (publishing) workflow experiment

Workflow.hs

module Workflow where

import           Data.Maybe
import           Data.Set

newtype State = State String deriving(Ord, Show, Eq)
type States = Set State
data Action = Action String deriving(Eq, Show)
type Workflow = [Transition]
data Transition = Transition {
    from     :: States
    , action :: Action
    , to     :: States
  }

states :: [String] -> States
states = fromList . (fmap State)

lookupTransition :: Action -> Workflow -> Maybe Transition
lookupTransition expectedAction workflow = listToMaybe $ Prelude.filter ((==expectedAction).action) workflow

transition :: Workflow -> States -> Action -> Maybe States
transition w currentMS request =
    lookupTransition request w
    >>=  (\transition ->
        case from transition `isSubsetOf` currentMS of
            True -> Just $ replace (from transition) currentMS (to transition)
            _ -> Nothing
    )

replace :: States -> States -> States -> States
replace needle haystack substitute = union substitute (difference haystack needle)

aWorkflow :: Workflow
aWorkflow = [
   Transition
        (states["Draft"])
        (Action "Publish")
        (states["Published"])
  , Transition
        (states["Published"])
        (Action "Unpublish")
        (states["Draft"])
 ]

complexWorkflow :: Workflow
complexWorkflow = [
    Transition
        (states["Draft"])
        (Action "RequestReview")
        (states["ReadyForJournalist", "ReadyForSpellChecker"])
   ,Transition
        (states["ReadyForJournalist"])
        (Action "ApproveByJournalist")
        (states["ApprovedByJournalist"])
   ,Transition
        (states["ReadyForSpellChecker"])
        (Action "ApproveBySpellChecker")
        (states["ApprovedBySpellChecker"])
   ,Transition
        (states["ApprovedByJournalist", "ApprovedBySpellChecker"])
        (Action "Publish")
        (states["Published"])
 ]


tests = [
    test aWorkflow
        ["Draft"]           -- given
        "Publish" $         -- when
        Just ["Published"]  -- then
    ,test aWorkflow
        ["Something"]
         "Publish"
        Nothing
    ,test aWorkflow
        ["Draft"]
        "Unpublish"
        Nothing
    ,test aWorkflow
        ["Draft"]
        "RequestReview" $
        Just ["ReadyForJournalist", "ReadyForSpellChecker"]
    ,test complexWorkflow
        ["ApprovedByJournalist", "SomeOtherState", "ApprovedBySpellChecker"]
        "Publish" $
        Just ["SomeOtherState", "Published"]
 ]

test :: Workflow -> [String] -> String -> Maybe  [String] -> Bool
test workflow given when then_ =
    transition workflow (states given) (Action when)
    == fmap states then_