blob: e4ba05ff29dce2b7a12af7a864da3d42ab016b0b (
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
50
51
52
53
54
|
module Data.Linked
( Linked (..)
, linkedHtml
, ToMaybe (..)
) where
import Prelude hiding (span, div)
import Prolog
import Data.Proxy
import Network.URI
import Text.Blaze.Html
import Text.Blaze.Html5 (a, span, div)
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 -> Just l) (toMaybe -> Nothing)) = a ! href (toValue l) $ toMarkup t
linkedHtml (Linked t (toMaybe -> l) (toMaybe -> Just tt)) = anchor $ toMarkup t <> (span ! class_ "tooltip" $ toMarkup tt)
where
anchor = case l of
Nothing -> div ! class_ "has-tooltip"
Just l' -> a ! class_ "has-tooltip" ! href (toValue l')
-- where
-- anchor
-- mklink x = maybe x ((!) x . href . toValue) l
-- mktooltip tt txt = maybe (toMarkup txt) (\tt' -> x <> (span ! class_ "tooltip" $ toMarkup tt')) tt
-- linkctxt = a !
-- maybe id withToolTip tt $ maybe id (\x -> a ! href (toValue x)) l $ 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 = div ! 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
|
