Adding more functionality

1 files changed, 31 insertions, 0 deletions

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]