robocop

commit 4ad2455090309d68b81cdde20fa351f0218b7e40
parent 36740c5078d83f6e08b661ffb1f4d2d45ac66831
Author: Vint Leenaars <vl.software@leenaa.rs>
Date:   Thu,  8 May 2025 23:22:19 +0200

Working JSON parser for NaturalPersons

Diffstat:
M
src/KYCheck/Check.hs
 | 
4
++--
M
src/KYCheck/GLS/Type.hs
 | 
20
+++++++++++++++-----

2 files changed, 17 insertions(+), 7 deletions(-)
diff --git a/src/KYCheck/Check.hs b/src/KYCheck/Check.hs
@@ -137,8 +137,8 @@ multFloats factor list toFloat = factor * foldl (\n x -> max n $ toFloat x) 0 li
 
 
 
-checkBirthDate :: Config -> Map Int (Quality (Year, Maybe DayOfYear)) -> Day -> [WithSSID QualityFloat]
-checkBirthDate config dates date = catMaybes $ map compareDate $ toList dates
+checkBirthDate :: Config -> Map Int (Quality (Year, Maybe DayOfYear)) -> CustomDay -> [WithSSID QualityFloat]
+checkBirthDate config dates (CustomDay date) = catMaybes $ map compareDate $ toList dates
   where compareDate (ssid, quality) = let
                                         ratio = case removeQuality quality of
                                                   (year, Just day_of_year) -> compareFullDate config year day_of_year date
diff --git a/src/KYCheck/GLS/Type.hs b/src/KYCheck/GLS/Type.hs
@@ -11,6 +11,7 @@
 
 module KYCheck.GLS.Type
   ( Address(..)
+  , CustomDay(..)
   , Entry(..)
   , LegalEntity(..)
   , NaturalPerson(..)
@@ -18,10 +19,11 @@ module KYCheck.GLS.Type
 
 import Control.Applicative ((<|>))
 
-import Data.Aeson
+import Data.Aeson (FromJSON(..), ToJSON(..), withText, withObject, (.:), (.:?))
 import Data.CountryCodes hiding (NP)
 import Data.Text
-import Data.Time.Calendar.OrdinalDate
+import Data.Time.Calendar (Day)
+import Data.Time.Format (defaultTimeLocale, parseTimeM)
 
 import GHC.Generics
 
@@ -29,13 +31,15 @@ data Entry = NP NaturalPerson
            | LE LegalEntity deriving (Show, Generic, Eq)
            -- | F
 
+newtype CustomDay = CustomDay Day deriving (Show, Eq, Generic)
+
 data NaturalPerson = NaturalPerson
   { full_name         :: Text
   , last_name         :: Text
   , residential       :: Address
 --  , phone             :: Maybe Text 
 --  , email             :: Maybe Text
-  , birthdate         :: Day         -- parseTimeM False defaultTimeLocale "%Y-%-m-%-d" YYYY-MM-DD
+  , birthdate         :: CustomDay -- parseTimeM False defaultTimeLocale "%Y-%-m-%-d" YYYY-MM-DD
   , nationality       :: CountryCode -- 2-letter ISO country-code 
   , national_id       :: Text
 --  , national_id_copy  :: FilePath
@@ -76,10 +80,10 @@ instance FromJSON NaturalPerson where
   parseJSON = withObject "natural_person" $ \p ->
     NaturalPerson <$> p .: "full_name"
                   <*> p .: "last_name"
-                  <*> p .: "residential"
+                  <*> p .: "address"
                   <*> p .: "birthdate"
                   <*> p .: "nationality"
-                  <*> p .: "text"
+                  <*> p .: "national_id"
 instance FromJSON Address where
   parseJSON = withObject "address" $ \a ->
     Address <$> a .:  "country"
@@ -100,7 +104,13 @@ instance FromJSON LegalEntity where
                 <*> e .:? "phone"
                 <*> e .:? "email"
                 <*> e .:  "id"
+instance FromJSON CustomDay where
+  parseJSON = withText "birthdate" $ \t ->
+    case parseTimeM False defaultTimeLocale "%Y-%-m-%-d" (unpack t) of
+      Just d -> pure $ CustomDay d
+      Nothing -> fail $ "Invalid Day format: " ++ unpack t
 
+instance ToJSON CustomDay
 instance ToJSON Entry
 instance ToJSON NaturalPerson
 instance ToJSON Address