Working on alias resolution

1 files changed, 29 insertions, 1 deletions

diff --git a/src/Data/Name.hs b/src/Data/Name.hs
index 9572709..b1f2739 100644
--- a/src/Data/Name.hs
+++ b/src/Data/Name.hs
@@ -10,6 +10,7 @@ module Data.Name
     ) where
 
 import Prolog
+import Data.Aeson
 import Data.Char (isSpace)
 import Data.List qualified as L
 import Data.Text qualified as T
@@ -19,7 +20,7 @@ data Name a = Name
     { lastName :: !a
     , firstName :: !a
     , middleName :: !(Maybe a)
-    } deriving (Eq, Functor, Foldable, Generic, Generic1, Ord, Show, Traversable)
+    } deriving (Eq, Functor, Foldable, Generic, Generic1, Hashable, Hashable1, Ord, Show, Traversable)
 
 type Name_ = Name StrictText
 
@@ -29,6 +30,33 @@ instance Applicative Name where
     pure a = Name a a (pure a)
     Name l f m <*> Name l' f' m' = Name (l l') (f f') (m <*> m')
 
+instance ToJSON a => ToJSON (Name a) where
+    toJSON (Name l f m) = object $
+        [ "first" .= f
+        , "last" .= l
+        ] <> maybe [] (pure . ("middle" .=)) m
+    toEncoding (Name l f m) = pairs $ fold $
+        [ "first" .= f
+        , "last" .= l
+        ] <> maybe [] (pure . ("middle" .=)) m
+
+instance StringConv s StrictText => ToJSONKey (Name s) where
+    toJSONKey = showNameLFM . toSL >$< toJSONKey
+
+instance StringConv StrictText s => FromJSONKey (Name s) where
+    fromJSONKey = FromJSONKeyTextParser $ fmap toSL . (readNameLFM <|> readNameFML)
+
+
+
+instance StringConv StrictText s => FromJSON (Name s) where
+    parseJSON (Object v) = fmap toSL $ Name
+        <$> v .: "first"
+        <*> v .: "last"
+        <*> v .:? "middle" .!= Nothing
+    parseJSON (String t) = toSL <$> readNameLFM t
+    parseJSON _ = empty
+
+
 
 readNameLFM :: Alternative m => StrictText -> m Name_
 readNameLFM t = T.map (\c -> if c == '~' then ' ' else c) <<$>>