A lot of work on aliases and the like

1 files changed, 44 insertions, 0 deletions

diff --git a/src/Data/Linked.hs b/src/Data/Linked.hs
new file mode 100644
index 0000000..8e78f86
--- /dev/null
+++ b/src/Data/Linked.hs
@@ -0,0 +1,44 @@
+module Data.Linked
+    ( Linked (..)
+    , linkedHtml
+    , ToMaybe (..)
+    ) where
+
+import Prelude hiding (span)
+import Prolog
+import Data.Proxy
+import Network.URI
+import Text.Blaze.Html
+import Text.Blaze.Html5 (a, span)
+import Text.Blaze.Html5.Attributes (href, class_)
+
+
+data Linked l t a = Linked
+    { baseText :: !a
+    , link :: !(l URI)
+    , tooltip :: !(t a)
+    }
+
+
+linkedHtml :: (ToMarkup a, ToMaybe l, ToMaybe t) => Linked l t a -> Html
+-- linkedHtml (Linked t (toMaybe -> Nothing) (toMaybe -> Nothing)) = toMarkup t
+linkedHtml (Linked t (toMaybe -> l) (toMaybe -> tt)) =
+    maybe id (\x -> a ! href (toValue x)) l $ maybe id withToolTip tt $ toMarkup t
+    -- a ! (maybe mempty (\x -> href $ toValue x) l) $ maybe id withToolTip tt $ toMarkup t
+-- ! (maybe mempty (\_ -> class_ "has-tooltip") tt) $ toMarkup t <> (maybe mempty (\x -> span ! class_ "tooltip" $ toMarkup x) tt)
+
+
+withToolTip :: (ToMarkup t) => t -> Html -> Html
+withToolTip tt h = a ! class_ "has-tooltip" $ h <> (span ! class_ "tooltip" $ toMarkup tt)
+
+class ToMaybe f where
+    toMaybe :: Alternative m => f a -> m a
+
+instance ToMaybe Maybe where
+    toMaybe = liftMaybe
+
+instance ToMaybe Identity where
+    toMaybe (Identity a) = pure a
+
+instance ToMaybe Proxy where
+    toMaybe _ = empty