summaryrefslogtreecommitdiff
path: root/src/Data
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data')
-rw-r--r--src/Data/Linked.hs32
-rw-r--r--src/Data/Paper.hs6
-rw-r--r--src/Data/Person.hs7
3 files changed, 29 insertions, 16 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
diff --git a/src/Data/Paper.hs b/src/Data/Paper.hs
index 0dedc46..b86b2f0 100644
--- a/src/Data/Paper.hs
+++ b/src/Data/Paper.hs
@@ -92,9 +92,9 @@ data ArXivType = ArXivAbs | ArXivPdf | ArXivSrc
arXivTypeRelative :: ArXivType -> URI
arXivTypeRelative = \case
- ArXivAbs -> [relativeReference|/abs|]
- ArXivPdf -> [relativeReference|/pdf|]
- ArXivSrc -> [relativeReference|/src|]
+ ArXivAbs -> [relativeReference|/abs/|]
+ ArXivPdf -> [relativeReference|/pdf/|]
+ ArXivSrc -> [relativeReference|/src/|]
arXivLink :: ArXivType -> ArXiv a -> URI
arXivLink at a = _identifier a `relativeTo` arXivTypeRelative at `relativeTo` arXivURI
diff --git a/src/Data/Person.hs b/src/Data/Person.hs
index 389d1ed..3dbdd80 100644
--- a/src/Data/Person.hs
+++ b/src/Data/Person.hs
@@ -27,8 +27,11 @@ instance Binary a => Binary (Person a)
type Person_ = Person StrictText
-personHtml :: (ToMarkup a) => Person a -> Html
-personHtml (Person n w) = linkedHtml $ Linked (contents $ renderNameFML $ contents . toMarkup <$> n) w Nothing
+personHtml :: (StringConv a StrictText) => Person a -> Html
+personHtml (Person n w) = linkedHtml $ Linked (renderNameFML $ ts <$> n) w Nothing
+ where
+ ts :: (StringConv a StrictText) => a -> StrictText
+ ts = toSL
personFromName :: Name a -> Person a
personFromName n = Person n Nothing