diff options
| author | Chris Wells <chris@mathematicaster.org> | 2026-01-29 15:33:24 -0600 |
|---|---|---|
| committer | Chris Wells <chris@mathematicaster.org> | 2026-01-29 15:33:24 -0600 |
| commit | 3a949d34da649b199235b06ab33927ad02cfdc26 (patch) | |
| tree | 3009bd8871dbb716aca93fd3bee0badba3bd717a /src/Data/Linked.hs | |
| parent | 0c2ae07a2952c4041d960e1dee9ebfd8c594d597 (diff) | |
| download | main-3a949d34da649b199235b06ab33927ad02cfdc26.tar main-3a949d34da649b199235b06ab33927ad02cfdc26.tar.gz main-3a949d34da649b199235b06ab33927ad02cfdc26.tar.bz2 main-3a949d34da649b199235b06ab33927ad02cfdc26.tar.lz main-3a949d34da649b199235b06ab33927ad02cfdc26.tar.xz main-3a949d34da649b199235b06ab33927ad02cfdc26.tar.zst main-3a949d34da649b199235b06ab33927ad02cfdc26.zip | |
Things are compiling nicely finally
Diffstat (limited to 'src/Data/Linked.hs')
| -rw-r--r-- | src/Data/Linked.hs | 32 |
1 files changed, 21 insertions, 11 deletions
diff --git a/src/Data/Linked.hs b/src/Data/Linked.hs index de1dc77..e4ba05f 100644 --- a/src/Data/Linked.hs +++ b/src/Data/Linked.hs @@ -4,12 +4,12 @@ module Data.Linked , ToMaybe (..) ) where -import Prelude hiding (span) +import Prelude hiding (span, div) import Prolog import Data.Proxy import Network.URI import Text.Blaze.Html -import Text.Blaze.Html5 (a, span) +import Text.Blaze.Html5 (a, span, div) import Text.Blaze.Html5.Attributes (href, class_) @@ -21,15 +21,25 @@ data Linked l t a = Linked 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) +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 |