Haskell Error Handling

Errors.hs

{-# LANGUAGE TypeFamilies, DataKinds, TypeInType, KindSignatures, TypeOperators, TypeApplications, StandaloneDeriving, ApplicativeDo, GeneralizedNewtypeDeriving #-}

import GHC.Types
import Data.Monoid
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Writer
import Control.Monad.Trans

data FieldStatus = Error | Normal

type family Choose (status :: FieldStatus) (a :: Type) (b :: Type) :: Type where
    Choose Normal a b = a
    Choose Error  a b = b


data User status = User { name :: Choose status String [String]
                        , uid :: Choose status String [String]
                        }

deriving instance Show (User Normal)
deriving instance Show (User Error)

instance Monoid (User Error) where
    mempty = User [] []
    (User a b) `mappend` (User c d) = User (a <> c) (b <> d)

type Value = ()

newtype MyMaybeT m a = MyM { runMyM :: m (Maybe a) } deriving (Functor)

deriving instance Show (m (Maybe a)) => Show (MyMaybeT m a)

myMaybeToMaybe = MaybeT . runMyM

instance MonadTrans MyMaybeT where
    lift = MyM . fmap Just

instance Monad m => Applicative (MyMaybeT m) where
    pure = lift . return
    mf <*> mx = MyM $ do
        mb_f <- runMyM mf
        case mb_f of
             Nothing -> runMyM mx >> return Nothing
             Just f -> do
                 mb_x <- runMyM mx
                 case mb_x of
                      Nothing -> return Nothing
                      Just x -> return (Just (f x))

instance Monad m => Monad (MyMaybeT m) where
    return = pure
    ma >>= mf = MyM $ runMaybeT $ (myMaybeToMaybe ma) >>= (myMaybeToMaybe . mf)


report :: Monoid e => e -> MyMaybeT (Writer e) a
report e = do
    lift $ tell e
    MyM $ return Nothing

validate :: Value -> MyMaybeT (Writer (User Error)) (User Normal)
validate () = do
    name <- report (mempty { name = ["Name cannot be shorter than three letters"] } )
    id <-  report (mempty { uid = ["ID must be an integer"] } )
    pure $ User name id