module Text.Reform.Result
( Result (..)
, getResult
, FormId
, zeroId
, mapId
, formIdList
, FormRange (..)
, incrementFormId
, unitRange
, isInRange
, isSubRange
, retainErrors
, retainChildErrors
) where
import Control.Applicative (Applicative (..))
import Data.List (intercalate)
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 :: [Integer]
} deriving (Eq, Ord)
zeroId :: String -> FormId
zeroId p = FormId
{ formPrefix = p
, formIdList = [0]
}
mapId :: ([Integer] -> [Integer]) -> FormId -> FormId
mapId f (FormId p is) = FormId p $ f is
instance Show FormId where
show (FormId p xs) =
p ++ "-fval[" ++ (intercalate "." $ reverse $ map show xs) ++ "]"
formId :: FormId -> Integer
formId = head . formIdList
data FormRange
= FormRange FormId FormId
deriving (Eq, Show)
incrementFormId :: FormId -> FormId
incrementFormId (FormId p (x:xs)) = FormId p $ (x + 1):xs
incrementFormId (FormId _ []) = error "Bad FormId list"
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)