refactor(avs): add case-insensitive aeson parsing facilities

This commit is contained in:
Steffen Jost 2022-06-30 17:59:52 +02:00
parent 3587e5cc75
commit ab32d9d5e9
2 changed files with 17 additions and 12 deletions

View File

@ -5,28 +5,32 @@ module Utils.Avs where
import Import.NoModel hiding ((.=)) import Import.NoModel hiding ((.=))
import Utils.Lens hiding ((.=)) import Utils.Lens hiding ((.=))
-- import qualified Data.HashMap.Lazy as HM import qualified Data.Set as Set
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Data.HashMap.Lazy as HM
import Data.Aeson import Data.Aeson
import Data.Aeson.Types import Data.Aeson.Types
import Servant import Servant
import Servant.Client import Servant.Client
-- just to speed up type checking -- import qualified Network.HTTP.Client as HTTP (newManager, defaultManagerSettings) -- just to speed up type checking
import qualified Data.Set as Set
import qualified Network.HTTP.Client as HTTP (newManager, defaultManagerSettings)
-- | Like (.:) but attempts parsing with case-insensitve keys as fallback. -- | Like (.:) but attempts parsing with case-insensitve keys as fallback.
-- Note that the type also works for optional Field
-- Taken from Data.Aeson.Filthy, which could somehow not be added as a dependency. -- Taken from Data.Aeson.Filthy, which could somehow not be added as a dependency.
{- (.:~) :: FromJSON a => Object -> Text -> Parser a
(.:~) :: FromJSON a => Object -> Text -> Parser a -- would be useful for AvsDataPersonStatus, where Case is inconsistently encoded
o .:~ key = o .: key <|> maybe empty parseJSON go o .:~ key = o .: key <|> maybe empty parseJSON go
where go = lookup (Text.toLower key) [(Text.toLower k, v) | (k,v) <- HM.toList o] where go = lookup (Text.toLower key) [(Text.toLower k, v) | (k,v) <- HM.toList o]
{-
-- Like (.:?) but attempts parsing with case-insensitve keys as fallback.
(.:?~) :: FromJSON a => Object -> Text -> Parser (Maybe a)
o .:?~ key = o .: key <|> maybe empty parseJSON go
where go = lookup (Text.toLower key) [(Text.toLower k, v) | (k,v) <- HM.toList o]
-} -}
newtype SloppyBool = SloppyBool { sloppyBool :: Bool } newtype SloppyBool = SloppyBool { sloppyBool :: Bool }
@ -229,7 +233,7 @@ mkAvsQuery basicAuth cliEnv = AvsQuery
(rawQueryPerson :<|> rawQueryStatus) = client avsApi basicAuth (rawQueryPerson :<|> rawQueryStatus) = client avsApi basicAuth
{-
-- DEMO to check that it types here instead of waiting for Application to be compiled -- DEMO to check that it types here instead of waiting for Application to be compiled
run :: IO () run :: IO ()
run = do run = do
@ -252,3 +256,4 @@ run = do
} }
avsAuth = BasicAuthData "foo" "bar" avsAuth = BasicAuthData "foo" "bar"
-}

View File

@ -16,13 +16,13 @@ test1 :: Either String AvsResponseStatus
test1 = eitherDecode status1 test1 = eitherDecode status1
person1 :: B.ByteString person1 :: B.ByteString
person1 = fromString "[{\"PersonID\":518870,\"PersonNo\":508870,\"InternalPersonalNo\":\"00057138\",\"LastName\":\"Jost\",\"FirstName\":\"Steffen\",\"personCards\":[{\"Firm\":\"AVN-AR2\",\"City\":null,\"Street\":null,\"PostalCode\":null,\"CardNo\":\"00158446\",\"VersionNo\":\"4\",\"CardColor\":\"Gelb\",\"CardAreas\":\"\",\"Valid\":\"true\",\"ValidTo\":\"2024-05-20\",\"IssueDate\":\"2019-09-02\"}]}]" person1 = fromString "[{\"PersonID\":518870,\"PersonNo\":508870,\"InternalPersonalNo\":\"00057138\",\"LastName\":\"Jost\",\"FirstName\":\"Steffen\",\"personCards\":[{\"Firm\":\"AVN-AR2\",\"City\":null,\"Street\":null,\"poStalcoDe\":\"64854\",\"CardNo\":\"00158446\",\"VersionNo\":\"4\",\"caRdcolor\":\"Violet\",\"CardAreas\":\"\",\"Valid\":\"true\",\"ValidTo\":\"2024-05-20\",\"IssueDate\":\"2019-09-02\"}]}]"
test2 :: Either String AvsResponsePerson test2 :: Either String AvsResponsePerson
test2 = eitherDecode person1 test2 = eitherDecode person1
person2 :: B.ByteString person2 :: B.ByteString
person2 = fromString "[{\"PersonID\":4026895,\"PersonNo\":1200216,\"InternalPersonalNo\":\"00056057\",\"LastName\":\"Zatschker\",\"FirstName\":\"Laura\",\"personCards\":[{\"Firm\":\"AVN-SR1\",\"City\":null,\"Street\":null,\"PostalCode\":null,\"CardNo\":\"00048614\",\"VersionNo\":\"4\",\"CardColor\":\"Gelb\",\"CardAreas\":\"F\",\"Valid\":\"true\",\"ValidTo\":\"2024-01-15\",\"IssueDate\":\"2020-03-18\"}]}]" person2 = fromString "[{\"PersonID\":4026895,\"PersonNo\":1200216,\"InternalPersonalNo\":\"00056057\",\"LastName\":\"Zatschker\",\"FirstName\":\"Laura\",\"personCards\":[{\"Firm\":\"AVN-SR1\",\"City\":null,\"Street\":null,\"PostalCode\":\"64853\",\"CardNo\":\"00048614\",\"VersionNo\":\"4\",\"CardColor\":\"Gelb\",\"CardAreas\":\"F\",\"Valid\":\"true\",\"ValidTo\":\"2024-01-15\",\"IssueDate\":\"2020-03-18\"}]}]"
test3 :: Either String AvsResponsePerson test3 :: Either String AvsResponsePerson
test3 = eitherDecode person2 test3 = eitherDecode person2