Things are compiling nicely finally

6 files changed, 44 insertions, 22 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
diff --git a/src/Hakyll/Alias.hs b/src/Hakyll/Alias.hs
index 73beb86..129ec42 100644
--- a/src/Hakyll/Alias.hs
+++ b/src/Hakyll/Alias.hs
@@ -29,6 +29,7 @@ aliasCtxtFrom name toa fromx ident = functionField1 name $ \s -> do
 -- personCtxt :: (StringConv StrictText s, Ord (Name s), ToMarkup s) => AliasMap (Name s) (Person s) -> Context a
 personCtxt :: Identifier -> Context a
 personCtxt = aliasCtxtFrom @Name_ @Person_ "personA" (parseName . toSL) (pure . toSL . personHtml)
+-- personCtxt = aliasCtxtFrom @Name_ @Person_ "personA" (parseName . toSL) (pure . toSL . (\(Person n _) -> toMarkup $ renderNameFML n))
 
 -- personCtxtFrom :: Identifier -> Context a
 -- personCtxtFrom = functionField1
diff --git a/src/Hakyll/Paper.hs b/src/Hakyll/Paper.hs
index 609f74d..06c45d0 100644
--- a/src/Hakyll/Paper.hs
+++ b/src/Hakyll/Paper.hs
@@ -27,14 +27,14 @@ authorCtxt = fold $
     [ field "name" $ pure . renderNameFML . fmap toSL . itemBody
     ]
 
-paperCtxt :: StringConv a String => FieldContext a -> Context (Paper a)
+paperCtxt :: StringConv a String => (forall b. Context b) -> Context (Paper a)
 paperCtxt fctxt = fold $
-    [ listFieldWith "authors" (_authorCtxt fctxt <> authorCtxt) $ pure . traverse authors
+    [ listFieldWith "authors" (fctxt <> authorCtxt) $ pure . traverse authors
       -- fmap pure . authors . itemBody
     , field "abstract" $ liftMaybe . fmap toSL . abstract . itemBody
     , field "title" $ pure . toSL . title . itemBody
     , field "key" $ pure . sluggedKey . itemBody
-    , status >$< (statusCtxt <> _journalCtxt fctxt)
+    , status >$< (statusCtxt <> fctxt)
     , listFieldWith "eprints" eprintCtxt $ pure . traverse eprints
     -- , eprint >$< maybeContext eprintCtxt
     , field "extra" $ \i -> case extraLink $ itemBody i of
@@ -47,7 +47,7 @@ paperCtxt fctxt = fold $
                                     _ -> fail $ "No extra for " <> k
     ]
 
-mkPaperContext :: (StringConv a String, StringConv String a) => FieldContext a -> [Paper a] -> Context b
+mkPaperContext :: (StringConv a String, StringConv String a) => (forall c. Context c) -> [Paper a] -> Context b
 mkPaperContext fctxt papers = listField "papers" (paperCtxt fctxt) $ do
     fp <- getResourceFilePath
     forM papers $ \p -> do
diff --git a/src/Prolog.hs b/src/Prolog.hs
index f7e72eb..1910a78 100644
--- a/src/Prolog.hs
+++ b/src/Prolog.hs
@@ -78,11 +78,13 @@ import Data.Bitraversable
 import Data.Bool
 import Data.ByteString qualified as B
 import Data.ByteString.Lazy qualified as BL
+import Data.Char qualified as C
 import Data.Either
 import Data.Foldable
 import Data.Function
 import Data.Functor
 import Data.Functor.Contravariant
+import Data.List qualified as L
 import Data.Map.Strict (Map)
 import Data.Maybe
 import Data.Set (Set)
@@ -233,10 +235,16 @@ instance StringConv Html T.Text where
     strConv l = strConv l . BT.renderHtml
 
 instance StringConv Html TL.Text where
-    strConv _ = BT.renderHtml
+    strConv _ = TL.strip . BT.renderHtml
 
 instance StringConv Html String where
-    strConv _ = BS.renderHtml
+    strConv _ = strip . BS.renderHtml
+      where
+        strip :: String -> String
+        strip = 
+          let d = L.dropWhile C.isSpace
+           in L.reverse . d . L.reverse . d
+
 
 instance StringConv Html B.ByteString where
     strConv l = strConv l . BB.renderHtml