{-# LANGUAGE DeriveFunctor #-}
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, Functor)
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
String
(NonEmpty Int)
| FormIdCustom
String
Int
deriving (Eq, Ord)
zeroId :: String -> FormId
zeroId prefix = FormId prefix (pure 0)
mapId :: (NonEmpty Int -> NonEmpty Int) -> 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 "." $ reverseMap show $ NE.toList xs)
show (FormIdCustom x _) = x
reverseMap :: Foldable t => (a -> b) -> t a -> [b]
reverseMap f = foldl (\as a -> f a : as ) []
formId :: FormId -> Int
formId (FormId _ (x :| _)) = x
formId (FormIdCustom _ x) = x
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)