Phantom.Alternative using phantom types

phantom-type-alternative.hs

{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE OverloadedStrings #-}

module Phantom.Alternative where

-- | universe of validation types
data Validated   = Validated
data Unvalidated = Unvalidated

newtype FormData a = MkFD { pfd :: (Maybe String, String) }

validated :: String -> FormData Validated
validated str = MkFD (Nothing, str)

unvalidated :: String -> String -> FormData Unvalidated
unvalidated user msg = MkFD (Just user, msg)

which :: FormData a -> Either (FormData Validated) (FormData Unvalidated)
which (MkFD (user, msg)) = maybe (Left $ validated msg) (Right . flip unvalidated msg) user

-- | validate data particular to a user
validateFD :: FormData a -> Maybe (FormData Validated)
validateFD = either Just check . which
  where
   check :: FormData Unvalidated -> Maybe (FormData Validated)
   check (MkFD (Just user, msg)) =
     if length msg == 10 && user == "aaron"
     then Just (validated msg)
     else Nothing

-- | do something with valid form data
useData :: FormData Validated -> IO ()
useData (MkFD (_, s)) = print s