Result.hs

-- | Module for the core result type, and related functions
--
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)

-- | Type for failing computations
--
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

-- | convert a 'Result' to 'Maybe' discarding the error message on 'Error'
getResult :: Result e ok -> Maybe ok
getResult (Error _) = Nothing
getResult (Ok r)    = Just r

-- | An ID used to identify forms
--
data FormId = FormId
    { -- | Global prefix for the form
      formPrefix :: String
    , -- | Stack indicating field. Head is most specific to this item
      formIdList :: [Integer]
    } deriving (Eq, Ord)

-- | The zero ID, i.e. the first ID that is usable
--
zeroId :: String -> FormId
zeroId p = FormId
    { formPrefix = p
    , formIdList = [0]
    }

-- | map a function over the @[Integer]@ inside a 'FormId'
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) ++ "]"

-- | get the head 'Integer' from a 'FormId'
formId :: FormId -> Integer
formId = head . formIdList

-- | A range of ID's to specify a group of forms
--
data FormRange
    = FormRange FormId FormId
      deriving (Eq, Show)

-- | Increment a form ID
--
incrementFormId :: FormId -> FormId
incrementFormId (FormId p (x:xs)) = FormId p $ (x + 1):xs
incrementFormId (FormId _ [])     = error "Bad FormId list"

-- | create a 'FormRange' from a 'FormId'
unitRange :: FormId -> FormRange
unitRange i = FormRange i $ incrementFormId i

-- | Check if a 'FormId' is contained in a 'FormRange'
--
isInRange :: FormId     -- ^ Id to check for
          -> FormRange  -- ^ Range
          -> Bool       -- ^ If the range contains the id
isInRange a (FormRange b c) = formId a >= formId b && formId a < formId c

-- | Check if a 'FormRange' is contained in another 'FormRange'
--
isSubRange :: FormRange  -- ^ Sub-range
           -> FormRange  -- ^ Larger range
           -> Bool       -- ^ If the sub-range is contained in the larger range
isSubRange (FormRange a b) (FormRange c d) =
    formId a >= formId c &&
    formId b <= formId d

-- | Select the errors for a certain range
--
retainErrors :: FormRange -> [(FormRange, e)] -> [e]
retainErrors range = map snd . filter ((== range) . fst)

-- | Select the errors originating from this form or from any of the children of
-- this form
--
retainChildErrors :: FormRange -> [(FormRange, e)] -> [e]
retainChildErrors range = map snd . filter ((`isSubRange` range) . fst)