summaryrefslogtreecommitdiff
path: root/src/Data/Name.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/Name.hs')
-rw-r--r--src/Data/Name.hs19
1 files changed, 13 insertions, 6 deletions
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