-- | 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 (Int -> Result e ok -> ShowS
[Result e ok] -> ShowS
Result e ok -> String
(Int -> Result e ok -> ShowS)
-> (Result e ok -> String)
-> ([Result e ok] -> ShowS)
-> Show (Result e ok)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e ok. (Show e, Show ok) => Int -> Result e ok -> ShowS
forall e ok. (Show e, Show ok) => [Result e ok] -> ShowS
forall e ok. (Show e, Show ok) => Result e ok -> String
showList :: [Result e ok] -> ShowS
$cshowList :: forall e ok. (Show e, Show ok) => [Result e ok] -> ShowS
show :: Result e ok -> String
$cshow :: forall e ok. (Show e, Show ok) => Result e ok -> String
showsPrec :: Int -> Result e ok -> ShowS
$cshowsPrec :: forall e ok. (Show e, Show ok) => Int -> Result e ok -> ShowS
Show, Result e ok -> Result e ok -> Bool
(Result e ok -> Result e ok -> Bool)
-> (Result e ok -> Result e ok -> Bool) -> Eq (Result e ok)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e ok. (Eq e, Eq ok) => Result e ok -> Result e ok -> Bool
/= :: Result e ok -> Result e ok -> Bool
$c/= :: forall e ok. (Eq e, Eq ok) => Result e ok -> Result e ok -> Bool
== :: Result e ok -> Result e ok -> Bool
$c== :: forall e ok. (Eq e, Eq ok) => Result e ok -> Result e ok -> Bool
Eq)

instance Functor (Result e) where
    fmap :: (a -> b) -> Result e a -> Result e b
fmap a -> b
_ (Error [(FormRange, e)]
x) = [(FormRange, e)] -> Result e b
forall e ok. [(FormRange, e)] -> Result e ok
Error [(FormRange, e)]
x
    fmap a -> b
f (Ok a
x)    = b -> Result e b
forall e ok. ok -> Result e ok
Ok (a -> b
f a
x)

instance Monad (Result e) where
    return :: a -> Result e a
return = a -> Result e a
forall e ok. ok -> Result e ok
Ok
    Error [(FormRange, e)]
x >>= :: Result e a -> (a -> Result e b) -> Result e b
>>= a -> Result e b
_ = [(FormRange, e)] -> Result e b
forall e ok. [(FormRange, e)] -> Result e ok
Error [(FormRange, e)]
x
    Ok a
x    >>= a -> Result e b
f = a -> Result e b
f a
x

instance Applicative (Result e) where
    pure :: a -> Result e a
pure = a -> Result e a
forall e ok. ok -> Result e ok
Ok
    Error [(FormRange, e)]
x <*> :: Result e (a -> b) -> Result e a -> Result e b
<*> Error [(FormRange, e)]
y = [(FormRange, e)] -> Result e b
forall e ok. [(FormRange, e)] -> Result e ok
Error ([(FormRange, e)] -> Result e b) -> [(FormRange, e)] -> Result e b
forall a b. (a -> b) -> a -> b
$ [(FormRange, e)]
x [(FormRange, e)] -> [(FormRange, e)] -> [(FormRange, e)]
forall a. [a] -> [a] -> [a]
++ [(FormRange, e)]
y
    Error [(FormRange, e)]
x <*> Ok a
_    = [(FormRange, e)] -> Result e b
forall e ok. [(FormRange, e)] -> Result e ok
Error [(FormRange, e)]
x
    Ok a -> b
_    <*> Error [(FormRange, e)]
y = [(FormRange, e)] -> Result e b
forall e ok. [(FormRange, e)] -> Result e ok
Error [(FormRange, e)]
y
    Ok a -> b
x    <*> Ok a
y    = b -> Result e b
forall e ok. ok -> Result e ok
Ok (b -> Result e b) -> b -> Result e b
forall a b. (a -> b) -> a -> b
$ a -> b
x a
y

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

-- | An ID used to identify forms
--
data FormId = FormId
    { -- | Global prefix for the form
      FormId -> String
formPrefix :: String
    , -- | Stack indicating field. Head is most specific to this item
      FormId -> [Integer]
formIdList :: [Integer]
    } deriving (FormId -> FormId -> Bool
(FormId -> FormId -> Bool)
-> (FormId -> FormId -> Bool) -> Eq FormId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormId -> FormId -> Bool
$c/= :: FormId -> FormId -> Bool
== :: FormId -> FormId -> Bool
$c== :: FormId -> FormId -> Bool
Eq, Eq FormId
Eq FormId
-> (FormId -> FormId -> Ordering)
-> (FormId -> FormId -> Bool)
-> (FormId -> FormId -> Bool)
-> (FormId -> FormId -> Bool)
-> (FormId -> FormId -> Bool)
-> (FormId -> FormId -> FormId)
-> (FormId -> FormId -> FormId)
-> Ord FormId
FormId -> FormId -> Bool
FormId -> FormId -> Ordering
FormId -> FormId -> FormId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FormId -> FormId -> FormId
$cmin :: FormId -> FormId -> FormId
max :: FormId -> FormId -> FormId
$cmax :: FormId -> FormId -> FormId
>= :: FormId -> FormId -> Bool
$c>= :: FormId -> FormId -> Bool
> :: FormId -> FormId -> Bool
$c> :: FormId -> FormId -> Bool
<= :: FormId -> FormId -> Bool
$c<= :: FormId -> FormId -> Bool
< :: FormId -> FormId -> Bool
$c< :: FormId -> FormId -> Bool
compare :: FormId -> FormId -> Ordering
$ccompare :: FormId -> FormId -> Ordering
$cp1Ord :: Eq FormId
Ord)

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

-- | map a function over the @[Integer]@ inside a 'FormId'
mapId :: ([Integer] -> [Integer]) -> FormId -> FormId
mapId :: ([Integer] -> [Integer]) -> FormId -> FormId
mapId [Integer] -> [Integer]
f (FormId String
p [Integer]
is) = String -> [Integer] -> FormId
FormId String
p ([Integer] -> FormId) -> [Integer] -> FormId
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Integer]
f [Integer]
is

instance Show FormId where
    show :: FormId -> String
show (FormId String
p [Integer]
xs) =
        String
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-fval[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Integer -> String) -> [Integer] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> String
forall a. Show a => a -> String
show [Integer]
xs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"

-- | get the head 'Integer' from a 'FormId'
formId :: FormId -> Integer
formId :: FormId -> Integer
formId = [Integer] -> Integer
forall a. [a] -> a
head ([Integer] -> Integer)
-> (FormId -> [Integer]) -> FormId -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormId -> [Integer]
formIdList

-- | A range of ID's to specify a group of forms
--
data FormRange
    = FormRange FormId FormId
      deriving (FormRange -> FormRange -> Bool
(FormRange -> FormRange -> Bool)
-> (FormRange -> FormRange -> Bool) -> Eq FormRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormRange -> FormRange -> Bool
$c/= :: FormRange -> FormRange -> Bool
== :: FormRange -> FormRange -> Bool
$c== :: FormRange -> FormRange -> Bool
Eq, Int -> FormRange -> ShowS
[FormRange] -> ShowS
FormRange -> String
(Int -> FormRange -> ShowS)
-> (FormRange -> String)
-> ([FormRange] -> ShowS)
-> Show FormRange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormRange] -> ShowS
$cshowList :: [FormRange] -> ShowS
show :: FormRange -> String
$cshow :: FormRange -> String
showsPrec :: Int -> FormRange -> ShowS
$cshowsPrec :: Int -> FormRange -> ShowS
Show)

-- | Increment a form ID
--
incrementFormId :: FormId -> FormId
incrementFormId :: FormId -> FormId
incrementFormId (FormId String
p (Integer
x:[Integer]
xs)) = String -> [Integer] -> FormId
FormId String
p ([Integer] -> FormId) -> [Integer] -> FormId
forall a b. (a -> b) -> a -> b
$ (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
:[Integer]
xs
incrementFormId (FormId String
_ [])     = String -> FormId
forall a. HasCallStack => String -> a
error String
"Bad FormId list"

-- | create a 'FormRange' from a 'FormId'
unitRange :: FormId -> FormRange
unitRange :: FormId -> FormRange
unitRange FormId
i = FormId -> FormId -> FormRange
FormRange FormId
i (FormId -> FormRange) -> FormId -> FormRange
forall a b. (a -> b) -> a -> b
$ FormId -> FormId
incrementFormId FormId
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 :: FormId -> FormRange -> Bool
isInRange FormId
a (FormRange FormId
b FormId
c) = FormId -> Integer
formId FormId
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= FormId -> Integer
formId FormId
b Bool -> Bool -> Bool
&& FormId -> Integer
formId FormId
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< FormId -> Integer
formId 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 -> FormRange -> Bool
isSubRange (FormRange FormId
a FormId
b) (FormRange FormId
c FormId
d) =
    FormId -> Integer
formId FormId
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= FormId -> Integer
formId FormId
c Bool -> Bool -> Bool
&&
    FormId -> Integer
formId FormId
b Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= FormId -> Integer
formId FormId
d

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

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