chore(avs): parse status response

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
+deriveJSON defaultOptions 
-  { fieldLabelModifier = mconcat . drop 3 . splitCamel
+  { fieldLabelModifier    = dropCamel 3
-  , omitNothingFields = True
+  , 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)

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

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