From c9e6d0ebabecf04e8f091234d293a85afe712057 Mon Sep 17 00:00:00 2001 From: Chris Wells Date: Fri, 31 Jan 2025 13:19:33 -0600 Subject: Adding more functionality --- src/Data/Person.hs | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) create mode 100644 src/Data/Person.hs (limited to 'src/Data/Person.hs') diff --git a/src/Data/Person.hs b/src/Data/Person.hs new file mode 100644 index 0000000..a649c07 --- /dev/null +++ b/src/Data/Person.hs @@ -0,0 +1,31 @@ +module Data.Person + ( Person (..) + , personHtml + , personFromName + , Name (..) + , URI + ) where + +import Prolog +import Data.Name +import Network.URI (URI) +import Text.Blaze +import Text.Blaze.Html +import Text.Blaze.Html5 (a) +import Text.Blaze.Html5.Attributes (href) + +data Person a = Person + { name :: !(Name a) + , webpage :: !(Maybe URI) + , aliases :: ![Name a] + } 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 [n] -- cgit v1.2.3