module Ditto.Result
( Result (..)
, getResult
, FormId (..)
, zeroId
, mapId
, FormRange (..)
, incrementFormId
, unitRange
, isInRange
, isSubRange
, retainErrors
, retainChildErrors
)
where
import Data.List (intercalate)
import Control.Applicative (Applicative (..))
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NE
data Result e ok
= Error [(FormRange, e)]
| Ok ok
deriving (Show, Eq)
instance Functor (Result e) where
fmap _ (Error x) = Error x
fmap f (Ok x) = Ok (f x)
instance Monad (Result e) where
return = Ok
Error x >>= _ = Error x
Ok x >>= f = f x
instance Applicative (Result e) where
pure = Ok
Error x <*> Error y = Error $ x ++ y
Error x <*> Ok _ = Error x
Ok _ <*> Error y = Error y
Ok x <*> Ok y = Ok $ x y
getResult :: Result e ok -> Maybe ok
getResult (Error _) = Nothing
getResult (Ok r) = Just r
data FormId
= FormId
{
formPrefix :: String
,
formIdList :: NonEmpty Integer
}
| FormIdCustom String
deriving (Eq, Ord)
zeroId :: String -> FormId
zeroId p = FormId
{ formPrefix = p
, formIdList = pure 0
}
mapId :: (NonEmpty Integer -> NonEmpty Integer) -> FormId -> FormId
mapId f (FormId p is) = FormId p $ f is
mapId _ x = x
instance Show FormId where
show (FormId p xs) =
p ++ "-fval[" ++ (intercalate "." $ reverse $ map show $ NE.toList xs) ++ "]"
show (FormIdCustom x) = x
formId :: FormId -> Integer
formId = NE.head . formIdList
data FormRange
= FormRange FormId FormId
deriving (Eq, Show)
incrementFormId :: FormId -> FormId
incrementFormId (FormId p (x :| xs)) = FormId p $ (x + 1) :| xs
incrementFormId x@FormIdCustom{} = x
unitRange :: FormId -> FormRange
unitRange i = FormRange i $ incrementFormId i
isInRange
:: FormId
-> FormRange
-> Bool
isInRange a (FormRange b c) = formId a >= formId b && formId a < formId c
isSubRange
:: FormRange
-> FormRange
-> Bool
isSubRange (FormRange a b) (FormRange c d) =
formId a >= formId c &&
formId b <=
formId d
retainErrors :: FormRange -> [(FormRange, e)] -> [e]
retainErrors range = map snd . filter ((== range) . fst)
retainChildErrors :: FormRange -> [(FormRange, e)] -> [e]
retainChildErrors range = map snd . filter ((`isSubRange` range) . fst)