{-# 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