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

module Tax.FDF where

import Data.Char (isDigit)
import Data.CAProvinceCodes qualified as Province
import Data.Fixed (Centi)
import Data.Foldable (find)
import Data.Functor.Const (Const (Const, getConst))
import Data.Map.Lazy (Map)
import Data.Map.Lazy qualified as Map
import Data.Semigroup.Cancellative (stripSuffix)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Time (Day, defaultTimeLocale, formatTime, parseTimeM)
import Rank2 qualified
import Text.FDF (FDF, foldMapWithKey, mapWithKey, parse, serialize)
import Text.Read (readEither)

data FieldConst a = Field {forall a. FieldConst a -> [Text]
path :: [Text], forall a. FieldConst a -> Entry a
entry :: Entry a}

data Entry a where
  Count :: Entry Word
  Date :: Entry Day
  Province :: Entry Province.Code
  Textual :: Entry Text
  Amount :: Entry Centi
  Percent :: Entry Rational
  Checkbox :: Entry Bool
  RadioButton :: (Bounded a, Enum a, Eq a, Show a) => [a] -> Entry a
  RadioButtons :: (Bounded a, Enum a, Eq a, Show a) => Text -> [a] -> Entry a
  Switch :: Text -> Text -> Text -> Entry Bool
  Switch' :: Text -> Entry Bool

deriving instance Show a => Show (Entry a)

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 :: [Text]
path = Text
rootText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
path}

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

update :: (Rank2.Apply form, Rank2.Foldable form) => form FieldConst -> form Maybe -> FDF -> FDF
update :: forall (form :: (* -> *) -> *).
(Apply form, Foldable form) =>
form FieldConst -> form Maybe -> FDF -> FDF
update form FieldConst
fields = ([Text] -> Text -> Text) -> FDF -> FDF
mapWithKey (([Text] -> Text -> Text) -> FDF -> FDF)
-> (form Maybe -> [Text] -> Text -> Text)
-> form Maybe
-> FDF
-> FDF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map [Text] Text -> [Text] -> Text -> Text
updateKey (Map [Text] Text -> [Text] -> Text -> Text)
-> (form Maybe -> Map [Text] Text)
-> form Maybe
-> [Text]
-> Text
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Const ([Text], Text) a -> Map [Text] Text)
-> form (Const ([Text], Text)) -> Map [Text] 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] -> Text -> Map [Text] Text)
-> ([Text], Text) -> Map [Text] Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Text] -> Text -> Map [Text] Text
forall k a. k -> a -> Map k a
Map.singleton (([Text], Text) -> Map [Text] Text)
-> (Const ([Text], Text) a -> ([Text], Text))
-> Const ([Text], Text) a
-> Map [Text] Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const ([Text], Text) a -> ([Text], Text)
forall {k} a (b :: k). Const a b -> a
getConst) (form (Const ([Text], Text)) -> Map [Text] Text)
-> (form Maybe -> form (Const ([Text], Text)))
-> form Maybe
-> Map [Text] Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. FieldConst a -> Maybe a -> Const ([Text], Text) a)
-> form FieldConst -> form Maybe -> form (Const ([Text], 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 ([Text], Text) a
forall a. FieldConst a -> Maybe a -> Const ([Text], Text) a
pairKey form FieldConst
fields
  where pairKey :: FieldConst a -> Maybe a -> Const ([Text], Text) a
        pairKey :: forall a. FieldConst a -> Maybe a -> Const ([Text], Text) a
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 = ([Text], Text) -> Const ([Text], Text) a
forall {k} a (b :: k). a -> Const a b
Const ((Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[0]") (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
path, (a -> Text) -> Maybe a -> 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 (Entry a -> a -> Text
forall a. Entry a -> a -> Text
fromEntry Entry a
entry) Maybe a
v)
        updateKey :: Map [Text] Text -> [Text] -> Text -> Text
        updateKey :: Map [Text] Text -> [Text] -> Text -> Text
updateKey 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
        fromEntry :: Entry a -> a -> Text
        fromEntry :: forall a. Entry a -> a -> Text
fromEntry Entry a
Textual a
v = a
Text
v
        fromEntry Entry a
Date a
v = 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
"Yes"
        fromEntry Entry a
Checkbox a
Bool
False = Text
"No"
        fromEntry (RadioButton [a]
values) a
v = 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
$ a -> Int
forall a. Enum a => a -> Int
fromEnum a
v Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        fromEntry Entry a
Amount a
v = String -> Text
Text.pack (a -> String
forall a. Show a => a -> String
show a
v)
        fromEntry Entry a
Percent a
v = String -> Text
Text.pack (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
"%"
        fromEntry Entry a
Count a
v = String -> Text
Text.pack (a -> String
forall a. Show a => a -> String
show a
v)
        fromEntry Entry a
Province a
v = 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
fields Map [Text] Text
fieldValues = (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 FieldConst a -> Either String (Maybe a)
forall a. FieldConst a -> Either String (Maybe a)
fill form FieldConst
fields
  where fill :: FieldConst a -> Either String (Maybe a)
        fill :: forall a. FieldConst a -> Either String (Maybe a)
fill 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 -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[0]") (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 Text
leaf [a]
values <- Entry a
entry,
            Just (Integer
n, a
v) <- ((Integer, a) -> Bool) -> [(Integer, a)] -> Maybe (Integer, a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Integer
i, a
_)-> (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 -> Bool
forall a b. (a -> b) -> a -> b
$
                                  [Text] -> Map [Text] Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (((Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[0]") (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
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 (Integer -> String
forall a. Show a => a -> String
show Integer
i) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"]) Map [Text] Text
fieldValues)
                           ([Integer] -> [a] -> [(Integer, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [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
v
          | 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 -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[0]") (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 -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[0]") (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. HasCallStack => String -> a
error (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 -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[0]") [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 -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[0]") [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. HasCallStack => String -> a
error (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. HasCallStack => String -> a
error (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 -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[0]") (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 -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[0]") (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 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)
        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 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"
          = 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. HasCallStack => String -> a
error ((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. HasCallStack => String -> a
error ((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. HasCallStack => String -> a
error ((Entry a, String) -> String
forall a. Show a => a -> String
show (Entry a
e, String
v))
        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

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