diff --git a/src/Utils/Avs.hs b/src/Utils/Avs.hs index 23f5ae4ea..9b9116cbe 100644 --- a/src/Utils/Avs.hs +++ b/src/Utils/Avs.hs @@ -1,3 +1,6 @@ +{-# OPTIONS_GHC -ddump-splices #-} +{-# LANGUAGE TemplateHaskell #-} + module Utils.Avs where import Import.NoModel @@ -7,7 +10,6 @@ import Servant.Client.Core (ClientError) import Utils.Lens - type AvsPersonResponse = Value type AvsStatusResponse = Value @@ -23,16 +25,58 @@ data AvsPersonQuery = AvsPersonQuery instance Default AvsPersonQuery where def = AvsPersonQuery Nothing Nothing Nothing Nothing Nothing -deriveJSON defaultOptions - { fieldLabelModifier = mconcat . drop 3 . splitCamel - , omitNothingFields = True +deriveJSON defaultOptions + { fieldLabelModifier = dropCamel 3 + , omitNothingFields = True , tagSingleConstructors = False + , rejectUnknownFields = False } ''AvsPersonQuery - newtype AvsStatusQuery = AvsStatusQuery (Set Int) deriveJSON defaultOptions ''AvsStatusQuery +newtype AvsResponseStatus = AvsResponseStatus (Set AvsDataPerson) + deriving (Eq, Ord, Read, Show, Generic, Typeable) +data AvsDataPerson = AvsDataPerson + { avsDataPersonID :: Int + , avsDataPersonCardStatus :: Set AvsDataPersonCard + } + deriving (Eq, Ord, Read, Show, Generic, Typeable) +data AvsDataPersonCard = AvsDataPersonCard + { avsDataCardAreas :: Maybe String + , avsDataCardColor :: String + , avsDataCardNo :: String + , avsDataValid :: String -- Bool; unfortunately, AVS encodes Booleans as JSON String "true" and "false" and not as JSON Booleans + , avsDataVersionNo :: String + } + deriving (Eq, Ord, Read, Show, Generic, Typeable) +-- data AvsDataCardColor = AvsCardColorRot | AvsCardColorGrün | AvsCardColorGelb | AvsCardColorBlau +deriveJSON defaultOptions + { fieldLabelModifier = dropCamel 2 + , omitNothingFields = True + , tagSingleConstructors = False + , rejectUnknownFields = False + } ''AvsDataPersonCard +deriveJSON defaultOptions + { fieldLabelModifier = \case { "avsDataPersonCardStatus" -> "personCardStatus"; others -> dropCamel 2 others } + , omitNothingFields = True + , tagSingleConstructors = False + , rejectUnknownFields = False + } ''AvsDataPerson +deriveJSON defaultOptions + { fieldLabelModifier = dropCamel 2 + , omitNothingFields = True + , tagSingleConstructors = False + , rejectUnknownFields = False + } ''AvsResponseStatus + +{- Instead of programming entirely by hand, why not dump splices and adjust? +instance FromJSON AvsDataPersonCard where + parseJSON (Object v) = AvsDataPersonCard + <$> v .:? "CardAreas" + <*> ... + <*> v .: "VersionNo" +-} data AvsQuery = AvsQuery { avsQueryPerson :: forall m. MonadIO m => AvsPersonQuery -> m (Either ClientError AvsPersonResponse) diff --git a/src/Utils/PathPiece.hs b/src/Utils/PathPiece.hs index 6e6d54950..085572065 100644 --- a/src/Utils/PathPiece.hs +++ b/src/Utils/PathPiece.hs @@ -2,7 +2,7 @@ module Utils.PathPiece ( nullaryToPathPiece', nullaryToPathPiece , nullaryPathPiece', nullaryPathPiece, finitePathPiece , derivePathPiece - , splitCamel + , splitCamel, dropCamel , camelToPathPiece, camelToPathPiece', camelToPathPiece'' , nameToPathPiece, nameToPathPiece' , tuplePathPiece @@ -211,6 +211,10 @@ splitCamel = map fromList . reverse . helper (error "hasChange undefined at star sameCategory = (==) `on` Char.generalCategory +dropCamel :: Textual t => Int -> t -> t +dropCamel n = mconcat . drop n . splitCamel + + -- | convert CamelCase to kebab-case, dropping parts at the start and the end camelToPathPiece'' :: Textual t => Natural -> Natural -> t -> t camelToPathPiece'' dropNStart dropNEnd = intercalate "-" . map toLower . drop (fromIntegral dropNStart) . dropEnd (fromIntegral dropNEnd) . splitCamel diff --git a/testdata/avs_json.hs b/testdata/avs_json.hs new file mode 100644 index 000000000..0251c7640 --- /dev/null +++ b/testdata/avs_json.hs @@ -0,0 +1,14 @@ + + +import Prelude +import Data.String +import qualified Data.ByteString.Lazy as B +import Data.Aeson +import Utils.Avs + + +status1 :: B.ByteString +status1 = fromString "[{\"PersonID\":10233,\"personCardStatus\":[{\"CardNo\":\"01234567\",\"VersionNo\":\"4\",\"CardColor\":\"Gelb\",\"CardAreas\":\"LY\",\"Valid\":\"true\"},{\"CardNo\":\"00001111\",\"VersionNo\":\"4\",\"CardColor\":\"Rot\",\"CardAreas\":\"F\",\"Valid\":\"true\"}]},{\"PersonID\":10444,\"personCardStatus\":[{\"CardNo\":\"11111111\",\"VersionNo\":\"4\",\"CardColor\":\"Gelb\",\"CardAreas\":\"LF\",\"Valid\":\"false\"}]}]" + +test1 :: Either String AvsResponseStatus +test1 = eitherDecode status1 \ No newline at end of file