From 79fcc03c19fc0ec27e416bdf6944f718d38f8e09 Mon Sep 17 00:00:00 2001
From: Chris Wells <chris@mathematicaster.org>
Date: Tue, 4 Feb 2025 15:10:57 -0600
Subject: Working on the alias module

---
 src/Data/Name.hs | 19 +++++++++++++------
 1 file changed, 13 insertions(+), 6 deletions(-)

(limited to 'src/Data/Name.hs')

diff --git a/src/Data/Name.hs b/src/Data/Name.hs
index b1f2739..ab49273 100644
--- a/src/Data/Name.hs
+++ b/src/Data/Name.hs
@@ -5,14 +5,18 @@ module Data.Name
     , readNameLFM
     , readNameFML
     -- * Writers
+    , showNameLFM
+    , showNameFML
     , renderNameLFM
     , renderNameFML
     ) where
 
 import Prolog
 import Data.Aeson
+import Data.Alias
 import Data.Char (isSpace)
 import Data.List qualified as L
+import Data.Set qualified as S
 import Data.Text qualified as T
 
 
@@ -20,12 +24,15 @@ data Name a = Name
     { lastName :: !a
     , firstName :: !a
     , middleName :: !(Maybe a)
-    } deriving (Eq, Functor, Foldable, Generic, Generic1, Hashable, Hashable1, Ord, Show, Traversable)
+    } deriving (Eq, Functor, Foldable, Generic, Generic1, Ord, Show, Traversable)
 
 type Name_ = Name StrictText
 
 instance Binary a => Binary (Name a)
 
+instance Ord a => ToAliases (Name a) (Name a) where
+    toAliases = S.singleton
+
 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')
@@ -40,20 +47,20 @@ instance ToJSON a => ToJSON (Name a) where
         , "last" .= l
         ] <> maybe [] (pure . ("middle" .=)) m
 
-instance StringConv s StrictText => ToJSONKey (Name s) where
-    toJSONKey = showNameLFM . toSL >$< toJSONKey
+instance (StringConv s StrictText, ToJSON s) => ToJSONKey (Name s) where
+    toJSONKey = showNameLFM . fmap toSL >$< toJSONKey
 
 instance StringConv StrictText s => FromJSONKey (Name s) where
-    fromJSONKey = FromJSONKeyTextParser $ fmap toSL . (readNameLFM <|> readNameFML)
+    fromJSONKey = FromJSONKeyTextParser $ \t -> toSL <<$>> (readNameLFM t <|> readNameFML t)
 
 
 
 instance StringConv StrictText s => FromJSON (Name s) where
-    parseJSON (Object v) = fmap toSL $ Name
+    parseJSON (Object v) = fmap (fmap $ toSL @StrictText) $ Name
         <$> v .: "first"
         <*> v .: "last"
         <*> v .:? "middle" .!= Nothing
-    parseJSON (String t) = toSL <$> readNameLFM t
+    parseJSON (String t) = toSL <<$>> (readNameLFM t <|> readNameFML t)
     parseJSON _ = empty
 
 
-- 
cgit v1.2.3