blob: c829fc4834818798771b68eee0b3a213236a8bf2 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
module Data.Person
( Person (..)
, personHtml
, personFromName
, Name (..)
, URI
) where
import Prolog
import Data.Aeson
import Data.Alias
import Data.Name
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)
} deriving (Eq, Functor, Foldable, Generic, Ord, Show, Traversable)
instance Binary a => Binary (Person a)
personHtml :: (ToMarkup a) => Person a -> Html
personHtml (Person n w) =
let withLink = maybe id (\x -> a ! href (toValue x)) w
in withLink $ renderNameFML $ toMarkup <$> n
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 FromAlias (Name a) (Person a) where
fromAlias n = pure $ Person n Nothing
|
