blob: de1dc771f574df868ec2fd8af8fe6ea54c4d8c49 (
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
|
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 x) = pure x
instance ToMaybe Proxy where
toMaybe _ = empty
|