Working on the alias module

1 files changed, 14 insertions, 35 deletions

diff --git a/src/Data/Person.hs b/src/Data/Person.hs
index e7c5f76..c829fc4 100644
--- a/src/Data/Person.hs
+++ b/src/Data/Person.hs
@@ -10,13 +10,18 @@ import Prolog
 import Data.Aeson
 import Data.Alias
 import Data.Name
-import Data.HashMap.Strict qualified as HM
+import Data.Set qualified as S
 import Network.URI (URI)
+import Network.URI qualified as URI
 import Text.Blaze
 import Text.Blaze.Html
 import Text.Blaze.Html5 (a)
 import Text.Blaze.Html5.Attributes (href)
 
+-- | Huh, I guess I need a version bump for this guy?
+instance FromJSON URI where
+    parseJSON = withText "URI" $ maybe (fail "Invalid URI") pure . URI.parseURI . toSL
+
 data Person a = Person
     { name :: !(Name a)
     , webpage :: !(Maybe URI)
@@ -32,39 +37,13 @@ personHtml (Person n w) =
 personFromName :: Name a -> Person a
 personFromName n = Person n Nothing
 
+instance FromJSON (Name a) => FromJSON (Person a) where
+    parseJSON = withObject "Person" $ \v -> Person
+        <$> v .: "name"
+        <*> v .:? "webpage" .!= Nothing
 
+instance Ord (Name a) => ToAliases (Person a) (Name a) where
+    toAliases = S.singleton . name
 
-instance (FromJSON (Name a), Hashable (Name a)) => FromJSON (WithAliases (Name a) (Person a)) where
-    parseJSON = withObject "Person" $ \v -> do
-        n <- v .: "name"
-        w <- v .:? "webpage" .!= Nothing
-        as <- v .:? "aliases" .!= mempty
-        pure $ WithAliases (HS.fromList $ n : as) (Person n w)
-
-instance (FromJSON (Name a), Hashable (Name a)) => FromJSON (AliasMap (Name a) (Person a)) where
-    parseJSON = fmap b . parseJSON
-        where
-            b :: [WithAliases (Name a) (Person a)] -> AliasMap (Name a) (Person a)
-            b = buildAliasMap
-
--- instance (StringConv StrictText a, Hashable a) => FromJSON (AliasMap (Name a) (Person a)) where
---     parseJSON v =
---         -- m >>= traverse x >>= pure . AliasMap . mk
---         where
---             m :: Parser (HM.HashMap (Name StrictText) Value)
---             m = parseJSON v
---             x :: Value -> Parser (Maybe URI, [Name StrictText])
---             x (Object o) = (,)
---                 <$> o .:? "webpage" .!= Nothing
---                 <*> o .:? "aliases" .!= mempty
---             x s@(String _) = (,) <$> (Just <$> parseJSON s) <*> pure mempty
---             x a@(Array _) = (,) <$> pure Nothing <*> parseJSON a
---             mk :: (StringConv StrictText t, Hashable t) => HM.HashMap (Name StrictText) (Maybe URI, [Name StrictText]) -> HM.HashMap (Name t) (Person t)
---             mk hm =
---                 let personify :: (Name a, (Maybe URI, [Name a])) -> ([Name a], Person a)
---                     personify (n, (w, ns)) = (n : ns, Person n w)
---                  in foldMap ((\(ns,p) -> HM.fromList $ (, (toSL <$> p)) . fmap toSL <$> ns ) . personify) $ HM.toList hm
-
-
-
--- -- instance ToJSON a => ToJSON (Person a) where
+instance FromAlias (Name a) (Person a) where
+    fromAlias n = pure $ Person n Nothing