{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}

-- | Utility functions for dealing with 'FDF' forms

module Tax.FDF (FDFs, FieldConst(..), Entry(..),
                mapForm, mapForm2, mapForms, load, loadAll, store, storeAll, update, updateAll, formKeys, within) where

import Control.Monad (join)
import Data.Biapplicative (biliftA2, biliftA3)
import Data.Bitraversable (bisequence, bitraverse)
import Data.CAProvinceCodes qualified as Province
import Data.Char (isDigit, isSpace)
import Data.Fixed (Centi)
import Data.Foldable (find)
import Data.Functor.Const (Const (Const, getConst))
import Data.List (elemIndex)
import Data.Map.Lazy (Map)
import Data.Map.Lazy qualified as Map
import Data.Semigroup (Endo (Endo, appEndo))
import Data.Semigroup.Cancellative (stripSuffix)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Time (Day, defaultTimeLocale, formatTime, parseTimeM)
import Data.Void (Void)
import Rank2 qualified
import Text.FDF (FDF (FDF, body), Field, foldMapWithKey, mapWithKey, parse, serialize, traverseWithKey)
import Text.Read (readEither)

-- | A form field path serves to uniquely identify and locate the field inside a form
data FieldConst a = Field {forall a. FieldConst a -> [Text]
path :: [Text], forall a. FieldConst a -> Entry a
entry :: Entry a}
                  | NoField

-- | The type of a single form field value
data Entry a where
  Constant :: (Eq a, Show a) => a -> Entry a -> Entry a
  Count :: Entry Word
  Date :: Entry Day
  Province :: Entry Province.Code
  Textual :: Entry Text
  Amount :: Entry Centi
  Percent :: Entry Rational
  Checkbox :: Entry Bool
  RadioButton :: (Eq a, Show a) => [a] -> Entry a
  RadioButtons :: (Bounded a, Enum a, Eq a, Show a) => Int -> Int -> Text -> [a] -> Entry a
  Switch :: Text -> Text -> Text -> Entry Bool
  Switch' :: Text -> Entry Bool

deriving instance Show a => Show (Entry a)

-- | A collection of 'FDF' forms keyed by a 'Text' identifier
type FDFs = Map Text FDF

-- | Add a head component to a field path
within :: Text -> FieldConst x -> FieldConst x
within :: forall x. Text -> FieldConst x -> FieldConst x
within Text
root field :: FieldConst x
field@Field{[Text]
path :: forall a. FieldConst a -> [Text]
path :: [Text]
path} = FieldConst x
field{path = root:path}
within Text
_ FieldConst x
NoField = FieldConst x
forall a. FieldConst a
NoField

-- | The list of all field paths inside a form
formKeys :: Rank2.Foldable form => form FieldConst -> [[Text]]
formKeys :: forall (form :: (* -> *) -> *).
Foldable form =>
form FieldConst -> [[Text]]
formKeys = (Endo [[Text]] -> [[Text]] -> [[Text]])
-> [[Text]] -> Endo [[Text]] -> [[Text]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Endo [[Text]] -> [[Text]] -> [[Text]]
forall a. Endo a -> a -> a
appEndo [] (Endo [[Text]] -> [[Text]])
-> (form FieldConst -> Endo [[Text]])
-> form FieldConst
-> [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. FieldConst a -> Endo [[Text]])
-> form FieldConst -> Endo [[Text]]
forall m (p :: * -> *).
Monoid m =>
(forall a. p a -> m) -> form p -> m
forall {k} (g :: (k -> *) -> *) m (p :: k -> *).
(Foldable g, Monoid m) =>
(forall (a :: k). p a -> m) -> g p -> m
Rank2.foldMap FieldConst a -> Endo [[Text]]
forall a. FieldConst a -> Endo [[Text]]
addEntry
  where addEntry :: FieldConst a -> Endo [[Text]]
        addEntry :: forall a. FieldConst a -> Endo [[Text]]
addEntry FieldConst a
NoField = Endo [[Text]]
forall a. Monoid a => a
mempty
        addEntry Field{[Text]
path :: forall a. FieldConst a -> [Text]
path :: [Text]
path, entry :: forall a. FieldConst a -> Entry a
entry = Switch Text
yes Text
no Text
leaf} = ([[Text]] -> [[Text]]) -> Endo [[Text]]
forall a. (a -> a) -> Endo a
Endo ([[Text]
path [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
yes, Text
leaf], [Text]
path [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
no, Text
leaf]] [[Text]] -> [[Text]] -> [[Text]]
forall a. [a] -> [a] -> [a]
++)
        addEntry Field{[Text]
path :: forall a. FieldConst a -> [Text]
path :: [Text]
path, entry :: forall a. FieldConst a -> Entry a
entry = Switch' Text
leaf} = ([[Text]] -> [[Text]]) -> Endo [[Text]]
forall a. (a -> a) -> Endo a
Endo ([[Text]
path [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
leaf], [Text]
path [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
leaf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[1]"]] [[Text]] -> [[Text]] -> [[Text]]
forall a. [a] -> [a] -> [a]
++)
        addEntry Field{[Text]
path :: forall a. FieldConst a -> [Text]
path :: [Text]
path} = ([[Text]] -> [[Text]]) -> Endo [[Text]]
forall a. (a -> a) -> Endo a
Endo ([Text]
path [Text] -> [[Text]] -> [[Text]]
forall a. a -> [a] -> [a]
:)

-- | Given a form's field paths and a function that modifies a form with optional field values, try to update an
-- 'FDF' with the form. Fail if any of the field paths can't be found in the form.
mapForm :: (Rank2.Apply form, Rank2.Traversable form)
        => form FieldConst -> (form Maybe -> form Maybe) -> FDF -> Either String FDF
mapForm :: forall (form :: (* -> *) -> *).
(Apply form, Traversable form) =>
form FieldConst
-> (form Maybe -> form Maybe) -> FDF -> Either String FDF
mapForm form FieldConst
fields form Maybe -> form Maybe
f FDF
fdf = form FieldConst -> FDF -> Either String (form Maybe)
forall (form :: (* -> *) -> *).
(Apply form, Traversable form) =>
form FieldConst -> FDF -> Either String (form Maybe)
load form FieldConst
fields FDF
fdf Either String (form Maybe)
-> (form Maybe -> Either String FDF) -> Either String FDF
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= form FieldConst -> FDF -> form Maybe -> Either String FDF
forall (form :: (* -> *) -> *).
(Apply form, Foldable form) =>
form FieldConst -> FDF -> form Maybe -> Either String FDF
store form FieldConst
fields FDF
fdf (form Maybe -> Either String FDF)
-> (form Maybe -> form Maybe) -> form Maybe -> Either String FDF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. form Maybe -> form Maybe
f

-- | Given the field paths of multiple forms with path heads distinguishing among the forms, and a function that
-- modifies a collection of forms with optional field values, try to update 'FDFs' of the forms. Fail if any of the
-- field paths can't be found in the forms.
mapForms :: (Rank2.Apply form, Rank2.Traversable form)
         => form FieldConst -> (form Maybe -> form Maybe) -> FDFs -> Either String FDFs
mapForms :: forall (form :: (* -> *) -> *).
(Apply form, Traversable form) =>
form FieldConst
-> (form Maybe -> form Maybe) -> FDFs -> Either String FDFs
mapForms form FieldConst
fields form Maybe -> form Maybe
f FDFs
fdfs = form FieldConst -> FDFs -> Either String (form Maybe)
forall (form :: (* -> *) -> *).
(Apply form, Traversable form) =>
form FieldConst -> FDFs -> Either String (form Maybe)
loadAll form FieldConst
fields FDFs
fdfs Either String (form Maybe)
-> (form Maybe -> Either String FDFs) -> Either String FDFs
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= form FieldConst -> FDFs -> form Maybe -> Either String FDFs
forall (form :: (* -> *) -> *).
(Apply form, Foldable form) =>
form FieldConst -> FDFs -> form Maybe -> Either String FDFs
storeAll form FieldConst
fields FDFs
fdfs (form Maybe -> Either String FDFs)
-> (form Maybe -> form Maybe) -> form Maybe -> Either String FDFs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. form Maybe -> form Maybe
f

-- | Given two forms' field paths and a function that modifies both forms with optional field values, try to update
-- two 'FDF's with the forms. Fail if any of the field paths can't be found in the forms.
mapForm2 :: (Rank2.Apply form1, Rank2.Apply form2, Rank2.Traversable form1, Rank2.Traversable form2)
         => (form1 FieldConst, form2 FieldConst)
         -> ((form1 Maybe, form2 Maybe) -> (form1 Maybe, form2 Maybe))
         -> (FDF, FDF)
         -> Either String (FDF, FDF)
mapForm2 :: forall (form1 :: (* -> *) -> *) (form2 :: (* -> *) -> *).
(Apply form1, Apply form2, Traversable form1, Traversable form2) =>
(form1 FieldConst, form2 FieldConst)
-> ((form1 Maybe, form2 Maybe) -> (form1 Maybe, form2 Maybe))
-> (FDF, FDF)
-> Either String (FDF, FDF)
mapForm2 (form1 FieldConst, form2 FieldConst)
fields (form1 Maybe, form2 Maybe) -> (form1 Maybe, form2 Maybe)
f (FDF, FDF)
fdfs = (Either String (form1 Maybe), Either String (form2 Maybe))
-> Either String (form1 Maybe, form2 Maybe)
forall (t :: * -> * -> *) (f :: * -> *) a b.
(Bitraversable t, Applicative f) =>
t (f a) (f b) -> f (t a b)
bisequence ((form1 FieldConst -> FDF -> Either String (form1 Maybe))
-> (form2 FieldConst -> FDF -> Either String (form2 Maybe))
-> (form1 FieldConst, form2 FieldConst)
-> (FDF, FDF)
-> (Either String (form1 Maybe), Either String (form2 Maybe))
forall a b c d e f.
(a -> b -> c) -> (d -> e -> f) -> (a, d) -> (b, e) -> (c, f)
forall (p :: * -> * -> *) a b c d e f.
Biapplicative p =>
(a -> b -> c) -> (d -> e -> f) -> p a d -> p b e -> p c f
biliftA2 form1 FieldConst -> FDF -> Either String (form1 Maybe)
forall (form :: (* -> *) -> *).
(Apply form, Traversable form) =>
form FieldConst -> FDF -> Either String (form Maybe)
load form2 FieldConst -> FDF -> Either String (form2 Maybe)
forall (form :: (* -> *) -> *).
(Apply form, Traversable form) =>
form FieldConst -> FDF -> Either String (form Maybe)
load (form1 FieldConst, form2 FieldConst)
fields (FDF, FDF)
fdfs) Either String (form1 Maybe, form2 Maybe)
-> ((form1 Maybe, form2 Maybe) -> Either String (FDF, FDF))
-> Either String (FDF, FDF)
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either String FDF, Either String FDF) -> Either String (FDF, FDF)
forall (t :: * -> * -> *) (f :: * -> *) a b.
(Bitraversable t, Applicative f) =>
t (f a) (f b) -> f (t a b)
bisequence ((Either String FDF, Either String FDF)
 -> Either String (FDF, FDF))
-> ((form1 Maybe, form2 Maybe)
    -> (Either String FDF, Either String FDF))
-> (form1 Maybe, form2 Maybe)
-> Either String (FDF, FDF)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (form1 FieldConst -> FDF -> form1 Maybe -> Either String FDF)
-> (form2 FieldConst -> FDF -> form2 Maybe -> Either String FDF)
-> (form1 FieldConst, form2 FieldConst)
-> (FDF, FDF)
-> (form1 Maybe, form2 Maybe)
-> (Either String FDF, Either String FDF)
forall (w :: * -> * -> *) a b c d e f g h.
Biapplicative w =>
(a -> b -> c -> d)
-> (e -> f -> g -> h) -> w a e -> w b f -> w c g -> w d h
biliftA3 form1 FieldConst -> FDF -> form1 Maybe -> Either String FDF
forall (form :: (* -> *) -> *).
(Apply form, Foldable form) =>
form FieldConst -> FDF -> form Maybe -> Either String FDF
store form2 FieldConst -> FDF -> form2 Maybe -> Either String FDF
forall (form :: (* -> *) -> *).
(Apply form, Foldable form) =>
form FieldConst -> FDF -> form Maybe -> Either String FDF
store (form1 FieldConst, form2 FieldConst)
fields (FDF, FDF)
fdfs ((form1 Maybe, form2 Maybe)
 -> (Either String FDF, Either String FDF))
-> ((form1 Maybe, form2 Maybe) -> (form1 Maybe, form2 Maybe))
-> (form1 Maybe, form2 Maybe)
-> (Either String FDF, Either String FDF)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (form1 Maybe, form2 Maybe) -> (form1 Maybe, form2 Maybe)
f

-- | Try to load all 'FDFs' into a form with optional values using the given field paths.
loadAll :: forall form. (Rank2.Apply form, Rank2.Traversable form) => form FieldConst -> FDFs -> Either String (form Maybe)
loadAll :: forall (form :: (* -> *) -> *).
(Apply form, Traversable form) =>
form FieldConst -> FDFs -> Either String (form Maybe)
loadAll form FieldConst
fields FDFs
fdfs = Map [Text] Text -> Either String (form Maybe)
fromPresentFieldMap (Map [Text] Text -> Either String (form Maybe))
-> Map [Text] Text -> Either String (form Maybe)
forall a b. (a -> b) -> a -> b
$ (Text -> FDF -> Map [Text] Text) -> FDFs -> Map [Text] Text
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey (\Text
k-> ([Text] -> Text -> Map [Text] Text) -> FDF -> Map [Text] Text
forall a. Monoid a => ([Text] -> Text -> a) -> FDF -> a
foldMapWithKey ([Text] -> Text -> Map [Text] Text
forall k a. k -> a -> Map k a
Map.singleton ([Text] -> Text -> Map [Text] Text)
-> ([Text] -> [Text]) -> [Text] -> Text -> Map [Text] Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[0]" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:))) FDFs
fdfs
  where fromPresentFieldMap :: Map [Text] Text -> Either String (form Maybe)
        fillPresent :: Map [Text] Text -> FieldConst a -> Either String (Maybe a)
        fromPresentFieldMap :: Map [Text] Text -> Either String (form Maybe)
fromPresentFieldMap Map [Text] Text
m = (forall a. FieldConst a -> Either String (Maybe a))
-> form FieldConst -> Either String (form Maybe)
forall {k} (g :: (k -> *) -> *) (m :: * -> *) (p :: k -> *)
       (q :: k -> *).
(Traversable g, Applicative m) =>
(forall (a :: k). p a -> m (q a)) -> g p -> m (g q)
forall (m :: * -> *) (p :: * -> *) (q :: * -> *).
Applicative m =>
(forall a. p a -> m (q a)) -> form p -> m (form q)
Rank2.traverse (Map [Text] Text -> FieldConst a -> Either String (Maybe a)
forall a.
Map [Text] Text -> FieldConst a -> Either String (Maybe a)
fillPresent Map [Text] Text
m) form FieldConst
fields
        fillPresent :: forall a.
Map [Text] Text -> FieldConst a -> Either String (Maybe a)
fillPresent Map [Text] Text
m f :: FieldConst a
f@Field {path :: forall a. FieldConst a -> [Text]
path = Text
root : [Text]
_}
          | Text -> FDFs -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Text
root FDFs
fdfs = Map [Text] Text -> FieldConst a -> Either String (Maybe a)
forall a.
Map [Text] Text -> FieldConst a -> Either String (Maybe a)
fill Map [Text] Text
m FieldConst a
f
        fillPresent Map [Text] Text
_ FieldConst a
_ = Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing

-- | Try to load an 'FDF' into a form with optional values using the given field paths.
load :: (Rank2.Apply form, Rank2.Traversable form) => form FieldConst -> FDF -> Either String (form Maybe)
load :: forall (form :: (* -> *) -> *).
(Apply form, Traversable form) =>
form FieldConst -> FDF -> Either String (form Maybe)
load form FieldConst
fields = form FieldConst -> Map [Text] Text -> Either String (form Maybe)
forall (form :: (* -> *) -> *).
Traversable form =>
form FieldConst -> Map [Text] Text -> Either String (form Maybe)
fromFieldMap form FieldConst
fields (Map [Text] Text -> Either String (form Maybe))
-> (FDF -> Map [Text] Text) -> FDF -> Either String (form Maybe)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Text -> Map [Text] Text) -> FDF -> Map [Text] Text
forall a. Monoid a => ([Text] -> Text -> a) -> FDF -> a
foldMapWithKey [Text] -> Text -> Map [Text] Text
forall k a. k -> a -> Map k a
Map.singleton

-- | Try to store a form with optional values into the given map of 'FDFs' according to given field paths. The heads
-- of the paths correspond to the map keys. Fail if any of the 'FDF's doesn't contain a field path, but ignore the
-- path heads not present among the keys of 'FDFs'.
storeAll :: (Rank2.Apply form, Rank2.Foldable form) => form FieldConst -> FDFs -> form Maybe -> Either String FDFs
storeAll :: forall (form :: (* -> *) -> *).
(Apply form, Foldable form) =>
form FieldConst -> FDFs -> form Maybe -> Either String FDFs
storeAll form FieldConst
fields = (form Maybe -> FDFs -> Either String FDFs)
-> FDFs -> form Maybe -> Either String FDFs
forall a b c. (a -> b -> c) -> b -> a -> c
flip (form FieldConst -> form Maybe -> FDFs -> Either String FDFs
forall (form :: (* -> *) -> *).
(Apply form, Foldable form) =>
form FieldConst -> form Maybe -> FDFs -> Either String FDFs
updateAll form FieldConst
fields)

-- | Try to store a form with optional values into the given 'FDF' according to given field paths. Fail if the 'FDF'
-- doesn't contain a field path.
store :: (Rank2.Apply form, Rank2.Foldable form) => form FieldConst -> FDF -> form Maybe -> Either String FDF
store :: forall (form :: (* -> *) -> *).
(Apply form, Foldable form) =>
form FieldConst -> FDF -> form Maybe -> Either String FDF
store form FieldConst
fields = (form Maybe -> FDF -> Either String FDF)
-> FDF -> form Maybe -> Either String FDF
forall a b c. (a -> b -> c) -> b -> a -> c
flip (form FieldConst -> form Maybe -> FDF -> Either String FDF
forall (form :: (* -> *) -> *).
(Apply form, Foldable form) =>
form FieldConst -> form Maybe -> FDF -> Either String FDF
update form FieldConst
fields)

-- | Try to update the given map of 'FDFs' from the form with optional values according to given field paths. The
-- heads of the paths correspond to the map keys. Fail if any of the 'FDF's doesn't contain a field path, but ignore
-- the path heads not present among the keys of 'FDFs'.
updateAll :: (Rank2.Apply form, Rank2.Foldable form) => form FieldConst -> form Maybe -> FDFs -> Either String FDFs
updateAll :: forall (form :: (* -> *) -> *).
(Apply form, Foldable form) =>
form FieldConst -> form Maybe -> FDFs -> Either String FDFs
updateAll form FieldConst
formFields form Maybe
formValues = case form FieldConst -> form Maybe -> Either String (Map [Text] Text)
forall (form :: (* -> *) -> *).
(Apply form, Foldable form) =>
form FieldConst -> form Maybe -> Either String (Map [Text] Text)
toFieldMap form FieldConst
formFields form Maybe
formValues of
  Left String
err -> Either String FDFs -> FDFs -> Either String FDFs
forall a b. a -> b -> a
const (String -> Either String FDFs
forall a b. a -> Either a b
Left String
err)
  Right Map [Text] Text
m -> FDFs -> Either String FDFs
forall a b. b -> Either a b
Right (FDFs -> Either String FDFs)
-> (FDFs -> FDFs) -> FDFs -> Either String FDFs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> FDF -> FDF) -> FDFs -> FDFs
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\Text
k-> ([Text] -> Text -> Text) -> FDF -> FDF
mapWithKey (Map [Text] Text -> [Text] -> Text -> Text
updateKeyFrom Map [Text] Text
m ([Text] -> Text -> Text)
-> ([Text] -> [Text]) -> [Text] -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[0]" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)))

-- | Try to update the given 'FDF' from the form with optional values according to given form field paths. Fail if
-- the 'FDF' doesn't contain a field path.
update :: (Rank2.Apply form, Rank2.Foldable form) => form FieldConst -> form Maybe -> FDF -> Either String FDF
update :: forall (form :: (* -> *) -> *).
(Apply form, Foldable form) =>
form FieldConst -> form Maybe -> FDF -> Either String FDF
update form FieldConst
formFields form Maybe
formValues = case form FieldConst -> form Maybe -> Either String (Map [Text] Text)
forall (form :: (* -> *) -> *).
(Apply form, Foldable form) =>
form FieldConst -> form Maybe -> Either String (Map [Text] Text)
toFieldMap form FieldConst
formFields form Maybe
formValues of
  Left String
err -> Either String FDF -> FDF -> Either String FDF
forall a b. a -> b -> a
const (String -> Either String FDF
forall a b. a -> Either a b
Left String
err)
  Right Map [Text] Text
m -> FDF -> Either String FDF
forall a b. b -> Either a b
Right (FDF -> Either String FDF)
-> (FDF -> FDF) -> FDF -> Either String FDF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Text -> Text) -> FDF -> FDF
mapWithKey (Map [Text] Text -> [Text] -> Text -> Text
updateKeyFrom Map [Text] Text
m)

updateKeyFrom :: Map [Text] Text -> [Text] -> Text -> Text
updateKeyFrom :: Map [Text] Text -> [Text] -> Text -> Text
updateKeyFrom Map [Text] Text
m [Text]
k Text
v = Text -> [Text] -> Map [Text] Text -> Text
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Text
v [Text]
k Map [Text] Text
m

toFieldMap :: (Rank2.Apply form, Rank2.Foldable form) => form FieldConst -> form Maybe -> Either String (Map [Text] Text)
toFieldMap :: forall (form :: (* -> *) -> *).
(Apply form, Foldable form) =>
form FieldConst -> form Maybe -> Either String (Map [Text] Text)
toFieldMap form FieldConst
fields = Map [Text] (Either String Text) -> Either String (Map [Text] Text)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
Map [Text] (f a) -> f (Map [Text] a)
sequenceA
                    (Map [Text] (Either String Text)
 -> Either String (Map [Text] Text))
-> (form Maybe -> Map [Text] (Either String Text))
-> form Maybe
-> Either String (Map [Text] Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
 Const (Maybe ([Text], Either String Text)) a
 -> Map [Text] (Either String Text))
-> form (Const (Maybe ([Text], Either String Text)))
-> Map [Text] (Either String Text)
forall m (p :: * -> *).
Monoid m =>
(forall a. p a -> m) -> form p -> m
forall {k} (g :: (k -> *) -> *) m (p :: k -> *).
(Foldable g, Monoid m) =>
(forall (a :: k). p a -> m) -> g p -> m
Rank2.foldMap ((([Text], Either String Text) -> Map [Text] (Either String Text))
-> Maybe ([Text], Either String Text)
-> Map [Text] (Either String Text)
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (([Text] -> Either String Text -> Map [Text] (Either String Text))
-> ([Text], Either String Text) -> Map [Text] (Either String Text)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Text] -> Either String Text -> Map [Text] (Either String Text)
forall k a. k -> a -> Map k a
Map.singleton) (Maybe ([Text], Either String Text)
 -> Map [Text] (Either String Text))
-> (Const (Maybe ([Text], Either String Text)) a
    -> Maybe ([Text], Either String Text))
-> Const (Maybe ([Text], Either String Text)) a
-> Map [Text] (Either String Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const (Maybe ([Text], Either String Text)) a
-> Maybe ([Text], Either String Text)
forall {k} a (b :: k). Const a b -> a
getConst)
                    (form (Const (Maybe ([Text], Either String Text)))
 -> Map [Text] (Either String Text))
-> (form Maybe
    -> form (Const (Maybe ([Text], Either String Text))))
-> form Maybe
-> Map [Text] (Either String Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. form FieldConst
-> form Maybe -> form (Const (Maybe ([Text], Either String Text)))
forall (form :: (* -> *) -> *).
(Apply form, Foldable form) =>
form FieldConst
-> form Maybe -> form (Const (Maybe ([Text], Either String Text)))
textualFields form FieldConst
fields

textualFields :: (Rank2.Apply form, Rank2.Foldable form)
              => form FieldConst -> form Maybe -> form (Const (Maybe ([Text], Either String Text)))
textualFields :: forall (form :: (* -> *) -> *).
(Apply form, Foldable form) =>
form FieldConst
-> form Maybe -> form (Const (Maybe ([Text], Either String Text)))
textualFields = (forall a.
 FieldConst a
 -> Maybe a -> Const (Maybe ([Text], Either String Text)) a)
-> form FieldConst
-> form Maybe
-> form (Const (Maybe ([Text], Either String Text)))
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *)
       (r :: k -> *).
Apply g =>
(forall (a :: k). p a -> q a -> r a) -> g p -> g q -> g r
forall (p :: * -> *) (q :: * -> *) (r :: * -> *).
(forall a. p a -> q a -> r a) -> form p -> form q -> form r
Rank2.liftA2 FieldConst a
-> Maybe a -> Const (Maybe ([Text], Either String Text)) a
forall a.
FieldConst a
-> Maybe a -> Const (Maybe ([Text], Either String Text)) a
pairKey
  where pairKey :: FieldConst a -> Maybe a -> Const (Maybe ([Text], Either String Text)) a
        pairKey :: forall a.
FieldConst a
-> Maybe a -> Const (Maybe ([Text], Either String Text)) a
pairKey Field {[Text]
path :: forall a. FieldConst a -> [Text]
path :: [Text]
path, entry :: forall a. FieldConst a -> Entry a
entry = RadioButtons Int
start Int
step Text
leaf [a]
values} (Just a
v)
          | Just Int
i <- a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
v [a]
values
          = Maybe ([Text], Either String Text)
-> Const (Maybe ([Text], Either String Text)) a
forall {k} a (b :: k). a -> Const a b
Const (Maybe ([Text], Either String Text)
 -> Const (Maybe ([Text], Either String Text)) a)
-> Maybe ([Text], Either String Text)
-> Const (Maybe ([Text], Either String Text)) a
forall a b. (a -> b) -> a -> b
$ ([Text], Either String Text) -> Maybe ([Text], Either String Text)
forall a. a -> Maybe a
Just ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
addIndex [Text]
path [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
leaf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
step) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"],
                          Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Enum a => a -> a
succ Int
i)
          | Bool
otherwise = Maybe ([Text], Either String Text)
-> Const (Maybe ([Text], Either String Text)) a
forall {k} a (b :: k). a -> Const a b
Const (Maybe ([Text], Either String Text)
 -> Const (Maybe ([Text], Either String Text)) a)
-> Maybe ([Text], Either String Text)
-> Const (Maybe ([Text], Either String Text)) a
forall a b. (a -> b) -> a -> b
$ ([Text], Either String Text) -> Maybe ([Text], Either String Text)
forall a. a -> Maybe a
Just ([Text]
path, String -> Either String Text
forall a b. a -> Either a b
Left (String
"Missing enum value " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
v))
        pairKey Field {[Text]
path :: forall a. FieldConst a -> [Text]
path :: [Text]
path, entry :: forall a. FieldConst a -> Entry a
entry = Switch Text
yes Text
no Text
leaf} (Just a
v) =
          Maybe ([Text], Either String Text)
-> Const (Maybe ([Text], Either String Text)) a
forall {k} a (b :: k). a -> Const a b
Const (Maybe ([Text], Either String Text)
 -> Const (Maybe ([Text], Either String Text)) a)
-> Maybe ([Text], Either String Text)
-> Const (Maybe ([Text], Either String Text)) a
forall a b. (a -> b) -> a -> b
$ ([Text], Either String Text) -> Maybe ([Text], Either String Text)
forall a. a -> Maybe a
Just (Text -> Text
addIndex (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Text]
path [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [if a
Bool
v then Text
yes else Text
no, Text
leaf]), Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ if a
Bool
v then Text
"1" else Text
"2")
        pairKey Field {[Text]
path :: forall a. FieldConst a -> [Text]
path :: [Text]
path, entry :: forall a. FieldConst a -> Entry a
entry = Switch' Text
leaf} (Just a
Bool
True) = Maybe ([Text], Either String Text)
-> Const (Maybe ([Text], Either String Text)) a
forall {k} a (b :: k). a -> Const a b
Const (Maybe ([Text], Either String Text)
 -> Const (Maybe ([Text], Either String Text)) a)
-> Maybe ([Text], Either String Text)
-> Const (Maybe ([Text], Either String Text)) a
forall a b. (a -> b) -> a -> b
$ ([Text], Either String Text) -> Maybe ([Text], Either String Text)
forall a. a -> Maybe a
Just (Text -> Text
addIndex (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Text]
path [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
leaf]), Text -> Either String Text
forall a b. b -> Either a b
Right Text
"1")
        pairKey Field {[Text]
path :: forall a. FieldConst a -> [Text]
path :: [Text]
path, entry :: forall a. FieldConst a -> Entry a
entry = Switch' Text
leaf} (Just a
Bool
False) =
          Maybe ([Text], Either String Text)
-> Const (Maybe ([Text], Either String Text)) a
forall {k} a (b :: k). a -> Const a b
Const (Maybe ([Text], Either String Text)
 -> Const (Maybe ([Text], Either String Text)) a)
-> Maybe ([Text], Either String Text)
-> Const (Maybe ([Text], Either String Text)) a
forall a b. (a -> b) -> a -> b
$ ([Text], Either String Text) -> Maybe ([Text], Either String Text)
forall a. a -> Maybe a
Just ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
addIndex [Text]
path [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
leaf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[1]"], Text -> Either String Text
forall a b. b -> Either a b
Right Text
"1")
        pairKey Field {[Text]
path :: forall a. FieldConst a -> [Text]
path :: [Text]
path, entry :: forall a. FieldConst a -> Entry a
entry = Constant a
c Entry a
e} (Just a
v)
          | a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v = Maybe ([Text], Either String Text)
-> Const (Maybe ([Text], Either String Text)) a
forall {k} a (b :: k). a -> Const a b
Const Maybe ([Text], Either String Text)
forall a. Maybe a
Nothing
          | Bool
otherwise = Maybe ([Text], Either String Text)
-> Const (Maybe ([Text], Either String Text)) a
forall {k} a (b :: k). a -> Const a b
Const (Maybe ([Text], Either String Text)
 -> Const (Maybe ([Text], Either String Text)) a)
-> Maybe ([Text], Either String Text)
-> Const (Maybe ([Text], Either String Text)) a
forall a b. (a -> b) -> a -> b
$ ([Text], Either String Text) -> Maybe ([Text], Either String Text)
forall a. a -> Maybe a
Just ([Text]
path, String -> Either String Text
forall a b. a -> Either a b
Left (String
"Trying to replace constant field " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([Text], a) -> String
forall a. Show a => a -> String
show ([Text]
path, a
c) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" with " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
v))
        pairKey Field {[Text]
path :: forall a. FieldConst a -> [Text]
path :: [Text]
path, Entry a
entry :: forall a. FieldConst a -> Entry a
entry :: Entry a
entry} Maybe a
v = Maybe ([Text], Either String Text)
-> Const (Maybe ([Text], Either String Text)) a
forall {k} a (b :: k). a -> Const a b
Const (Maybe ([Text], Either String Text)
 -> Const (Maybe ([Text], Either String Text)) a)
-> Maybe ([Text], Either String Text)
-> Const (Maybe ([Text], Either String Text)) a
forall a b. (a -> b) -> a -> b
$ ([Text], Either String Text) -> Maybe ([Text], Either String Text)
forall a. a -> Maybe a
Just (Text -> Text
addIndex (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
path, Either String Text
-> (a -> Either String Text) -> Maybe a -> Either String Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either String Text
forall a b. b -> Either a b
Right Text
"") (Entry a -> a -> Either String Text
forall a. Entry a -> a -> Either String Text
fromEntry Entry a
entry) Maybe a
v)
        pairKey FieldConst a
NoField Maybe a
_ = Maybe ([Text], Either String Text)
-> Const (Maybe ([Text], Either String Text)) a
forall {k} a (b :: k). a -> Const a b
Const Maybe ([Text], Either String Text)
forall a. Maybe a
Nothing
        fromEntry :: Entry a -> a -> Either String Text
        fromEntry :: forall a. Entry a -> a -> Either String Text
fromEntry (Constant a
c Entry a
e) a
_ = Entry a -> a -> Either String Text
forall a. Entry a -> a -> Either String Text
fromEntry Entry a
e a
c
        fromEntry Entry a
Textual a
v = Text -> Either String Text
forall a b. b -> Either a b
Right a
Text
v
        fromEntry Entry a
Date a
v = Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String -> a -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%Y%m%d" a
v
        fromEntry Entry a
Checkbox a
Bool
True = Text -> Either String Text
forall a b. b -> Either a b
Right Text
"Yes"
        fromEntry Entry a
Checkbox a
Bool
False = Text -> Either String Text
forall a b. b -> Either a b
Right Text
"No"
        fromEntry e :: Entry a
e@(RadioButton [a]
values) a
v = case a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
v [a]
values
                                             of Just Int
i -> Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
                                                Maybe Int
Nothing -> String -> Either String Text
forall a b. a -> Either a b
Left (Entry a -> String
forall a. Show a => a -> String
show Entry a
e String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" doesn't allow value " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
v)
        fromEntry Entry a
Amount a
v = Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (a -> String
forall a. Show a => a -> String
show a
v)
        fromEntry Entry a
Percent a
v = Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
dropInsignificantZeros (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Fixed E2 -> String
forall a. Show a => a -> String
show (Ratio Integer -> Fixed E2
forall a. Fractional a => Ratio Integer -> a
fromRational (Ratio Integer -> Fixed E2) -> Ratio Integer -> Fixed E2
forall a b. (a -> b) -> a -> b
$ a
Ratio Integer
v Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* Ratio Integer
100 :: Centi)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%"
          where dropInsignificantZeros :: Text -> Text
dropInsignificantZeros = (Char -> Bool) -> Text -> Text
Text.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
Text.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0')
        fromEntry Entry a
Count a
v = Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (a -> String
forall a. Show a => a -> String
show a
v)
        fromEntry Entry a
Province a
v = Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (a -> String
forall a. Show a => a -> String
show a
v)

fromFieldMap :: Rank2.Traversable form => form FieldConst -> Map [Text] Text -> Either String (form Maybe)
fromFieldMap :: forall (form :: (* -> *) -> *).
Traversable form =>
form FieldConst -> Map [Text] Text -> Either String (form Maybe)
fromFieldMap form FieldConst
fieldForm Map [Text] Text
fieldMap = (forall a. FieldConst a -> Either String (Maybe a))
-> form FieldConst -> Either String (form Maybe)
forall {k} (g :: (k -> *) -> *) (m :: * -> *) (p :: k -> *)
       (q :: k -> *).
(Traversable g, Applicative m) =>
(forall (a :: k). p a -> m (q a)) -> g p -> m (g q)
forall (m :: * -> *) (p :: * -> *) (q :: * -> *).
Applicative m =>
(forall a. p a -> m (q a)) -> form p -> m (form q)
Rank2.traverse (Map [Text] Text -> FieldConst a -> Either String (Maybe a)
forall a.
Map [Text] Text -> FieldConst a -> Either String (Maybe a)
fill Map [Text] Text
fieldMap) form FieldConst
fieldForm

fill :: forall a. Map [Text] Text -> FieldConst a -> Either String (Maybe a)
fill :: forall a.
Map [Text] Text -> FieldConst a -> Either String (Maybe a)
fill Map [Text] Text
fieldValues FieldConst a
NoField = Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
fill Map [Text] Text
fieldValues Field {[Text]
path :: forall a. FieldConst a -> [Text]
path :: [Text]
path, Entry a
entry :: forall a. FieldConst a -> Entry a
entry :: Entry a
entry}
  | Just Text
v <- [Text] -> Map [Text] Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Text]
path Map [Text] Text
fieldValues = Entry a -> String -> Either String (Maybe a)
forall a. Entry a -> String -> Either String (Maybe a)
toEntry Entry a
entry (Text -> String
Text.unpack Text
v)
  | Just Text
v <- [Text] -> Map [Text] Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text -> Text
addIndex (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
path) Map [Text] Text
fieldValues = Entry a -> String -> Either String (Maybe a)
forall a. Entry a -> String -> Either String (Maybe a)
toEntry Entry a
entry (Text -> String
Text.unpack Text
v)
  | RadioButtons Int
start Int
step Text
leaf [a]
values <- Entry a
entry,
    [(Maybe Text, a)]
alts <- [ ([Text] -> Map [Text] Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
addIndex [Text]
path [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
leaf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
step) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"]) Map [Text] Text
fieldValues,
               a
v)
            | (Int
i, a
v) <- [Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [a]
values ]
  = if [(Maybe Text, a)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Maybe Text, a)]
alts then String -> Either String (Maybe a)
forall a b. a -> Either a b
Left (String
"No radio buttons on path " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Text] -> String
forall a. Show a => a -> String
show [Text]
path)
    else Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right (Maybe a -> Either String (Maybe a))
-> Maybe a -> Either String (Maybe a)
forall a b. (a -> b) -> a -> b
$ (Maybe Text, a) -> a
forall a b. (a, b) -> b
snd ((Maybe Text, a) -> a) -> Maybe (Maybe Text, a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Maybe Text, a) -> Bool)
-> [(Maybe Text, a)] -> Maybe (Maybe Text, a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Bool) -> Maybe Text -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"", Text
"Off"]) (Maybe Text -> Bool)
-> ((Maybe Text, a) -> Maybe Text) -> (Maybe Text, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text, a) -> Maybe Text
forall a b. (a, b) -> a
fst) ([(Maybe Text, a)]
alts :: [(Maybe Text, a)])
  | Switch Text
yes Text
no Text
leaf <- Entry a
entry,
    Just Text
yesValue <- [Text] -> Map [Text] Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text -> Text
addIndex (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Text]
path [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
yes, Text
leaf])) Map [Text] Text
fieldValues,
    Just Text
noValue <- [Text] -> Map [Text] Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text -> Text
addIndex (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Text]
path [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
no, Text
leaf])) Map [Text] Text
fieldValues
  = if Text
yesValue Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"", Text
"Off"] Bool -> Bool -> Bool
&& Text
noValue Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"", Text
"Off"] then Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
    else if Text
yesValue Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"1" Bool -> Bool -> Bool
&& Text
noValue Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"", Text
"Off"] then Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right (a -> Maybe a
forall a. a -> Maybe a
Just a
Bool
True)
    else if Text
yesValue Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"", Text
"Off"] Bool -> Bool -> Bool
&& Text
noValue Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"1", Text
"2"] then Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right (a -> Maybe a
forall a. a -> Maybe a
Just a
Bool
False)
    else String -> Either String (Maybe a)
forall a b. a -> Either a b
Left (String
"Can't figure out the checkbox at " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ([Text], Entry a, Text, Text) -> String
forall a. Show a => a -> String
show ([Text]
path, Entry a
entry, Text
yesValue, Text
noValue))
  | Switch' Text
leaf <- Entry a
entry,
    Just Text
yesValue <- [Text] -> Map [Text] Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
addIndex [Text]
path [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
leaf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[0]"]) Map [Text] Text
fieldValues,
    Just Text
noValue <- [Text] -> Map [Text] Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
addIndex [Text]
path [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
leaf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[1]"]) Map [Text] Text
fieldValues
  = if Text
yesValue Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"", Text
"Off"] Bool -> Bool -> Bool
&& Text
noValue Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"", Text
"Off"] then Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
    else if Text
yesValue Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"1" Bool -> Bool -> Bool
&& Text
noValue Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"", Text
"Off"] then Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right (a -> Maybe a
forall a. a -> Maybe a
Just a
Bool
True)
    else if Text
yesValue Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"", Text
"Off"] Bool -> Bool -> Bool
&& Text
noValue Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"1", Text
"2"] then Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right (a -> Maybe a
forall a. a -> Maybe a
Just a
Bool
False)
    else String -> Either String (Maybe a)
forall a b. a -> Either a b
Left (String
"Can't figure out the checkbox at " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ([Text], Entry a, Text, Text) -> String
forall a. Show a => a -> String
show ([Text]
path, Entry a
entry, Text
yesValue, Text
noValue))
  | Bool
otherwise = String -> Either String (Maybe a)
forall a b. a -> Either a b
Left (String
"Unknown field path " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Text] -> String
forall a. Show a => a -> String
show [Text]
path String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" between "
                       String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Maybe ([Text], Text), Maybe ([Text], Text)) -> String
forall a. Show a => a -> String
show ([Text] -> Map [Text] Text -> Maybe ([Text], Text)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLT (Text -> Text
addIndex (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
path) Map [Text] Text
fieldValues,
                                [Text] -> Map [Text] Text -> Maybe ([Text], Text)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupGT (Text -> Text
addIndex (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
path) Map [Text] Text
fieldValues))

toEntry :: Entry a -> String -> Either String (Maybe a)
toEntry :: forall a. Entry a -> String -> Either String (Maybe a)
toEntry Entry a
_ String
"" = Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
toEntry (Constant a
expected Entry a
entry) String
v = do
  Maybe a
e <- Entry a -> String -> Either String (Maybe a)
forall a. Entry a -> String -> Either String (Maybe a)
toEntry Entry a
entry String
v
  if Maybe a
e Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Maybe a
forall a. a -> Maybe a
Just a
expected
    then Maybe a -> Either String (Maybe a)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
e
    else String -> Either String (Maybe a)
forall a b. a -> Either a b
Left (String
"Expected " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
expected String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (String, Maybe a) -> String
forall a. Show a => a -> String
show (String
v, Maybe a
e))
toEntry Entry a
Count String
v = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Either String a -> Either String (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String a
forall a. Read a => String -> Either String a
readEither String
v
toEntry Entry a
Date String
v = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Either String a -> Either String (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> TimeLocale -> String -> String -> Either String a
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale String
"%Y%m%d" String
v
toEntry Entry a
Province String
v = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Either String a -> Either String (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String a
forall a. Read a => String -> Either String a
readEither String
v
toEntry Entry a
Textual String
v = Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right (Maybe a -> Either String (Maybe a))
-> Maybe a -> Either String (Maybe a)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
v
toEntry Entry a
Amount String
v = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Either String a -> Either String (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String a
forall a. Read a => String -> Either String a
readEither (ShowS
dropCommas String
v)
  where dropCommas :: ShowS
dropCommas String
num
          | (String
wholePart, pointyPart :: String
pointyPart@(Char
'.' : String
decimals)) <- (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') String
num,
            String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
decimals Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2,
            (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
decimals
          = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',') String
wholePart String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
pointyPart
          | Bool
otherwise = String
num
toEntry Entry a
Percent String
v
  | Just String
v' <- String -> String -> Maybe String
forall m. RightReductive m => m -> m -> Maybe m
stripSuffix String
"%" String
v,
    (String
wholePart, String
pointyPart) <- (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') String
v',
    Right a
whole <- Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> Either String Integer -> Either String a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String Integer
forall a. Read a => String -> Either String a
readEither String
wholePart,
    Right a
decimal <- case (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) String
pointyPart
                     of Char
'.' : String
decimals -> (a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
10 a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
decimals) (a -> a) -> (Integer -> a) -> Integer -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> Either String Integer -> Either String a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String Integer
forall a. Read a => String -> Either String a
readEither String
decimals
                        String
"" -> a -> Either String a
forall a b. b -> Either a b
Right a
0
                        String
_ -> String -> Either String a
forall a b. a -> Either a b
Left (String
"Bad decimals: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> String
show String
v')
  = Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right (Maybe a -> Either String (Maybe a))
-> Maybe a -> Either String (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just ((a
whole a -> a -> a
forall a. Num a => a -> a -> a
+ a
decimal) a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
100)
  | Bool
otherwise = String -> Either String (Maybe a)
forall a b. a -> Either a b
Left (String
"Bad percentage value: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> String
show String
v)
toEntry Entry a
Checkbox String
"Yes" = Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right (Maybe a -> Either String (Maybe a))
-> Maybe a -> Either String (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
Bool
True
toEntry Entry a
Checkbox String
"No" = Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right (Maybe a -> Either String (Maybe a))
-> Maybe a -> Either String (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
Bool
False
toEntry Entry a
Checkbox String
"Off" = Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right (Maybe a -> Either String (Maybe a))
-> Maybe a -> Either String (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
Bool
False
toEntry Entry a
Checkbox String
"1" = Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right (Maybe a -> Either String (Maybe a))
-> Maybe a -> Either String (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
Bool
True
toEntry Entry a
Checkbox String
v = String -> Either String (Maybe a)
forall a b. a -> Either a b
Left (String
"Bad checkbox value: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> String
show String
v)
toEntry e :: Entry a
e@(RadioButton [a]
values) String
v
  | Right Int
n <- String -> Either String Int
forall a. Read a => String -> Either String a
readEither String
v, Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0, a
x:[a]
_ <- Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
values = Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right (Maybe a -> Either String (Maybe a))
-> Maybe a -> Either String (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
x
  | Bool
otherwise = String -> Either String (Maybe a)
forall a b. a -> Either a b
Left (String
"Bad radio button value: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Entry a, String) -> String
forall a. Show a => a -> String
show (Entry a
e, String
v))
toEntry e :: Entry a
e@RadioButtons{} String
v = String -> Either String (Maybe a)
forall a b. a -> Either a b
Left ((Entry a, String) -> String
forall a. Show a => a -> String
show (Entry a
e, String
v))
toEntry e :: Entry a
e@(Switch Text
a Text
b Text
leaf) String
v = String -> Either String (Maybe a)
forall a b. a -> Either a b
Left ((Entry a, String) -> String
forall a. Show a => a -> String
show (Entry a
e, String
v))
toEntry e :: Entry a
e@(Switch' Text
leaf) String
v = String -> Either String (Maybe a)
forall a b. a -> Either a b
Left ((Entry a, String) -> String
forall a. Show a => a -> String
show (Entry a
e, String
v))

addIndex :: Text -> Text
addIndex :: Text -> Text
addIndex Text
key
  | Text
"]" Text -> Text -> Bool
`Text.isSuffixOf` Text
key = Text
key
  | Bool
otherwise = Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[0]"

instance MonadFail (Either String) where
  fail :: forall a. String -> Either String a
fail = String -> Either String a
forall a b. a -> Either a b
Left