From fdd5a0391de9888ed02f2f8143e0ba9df8ee3ee8 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Sat, 5 Feb 2022 23:15:42 +0100 Subject: [PATCH] [html] add light theme; add cli option to pick theme --- app/Main.hs | 19 +++- assets/source-ayu-light.css | 44 ++++++++++ assets/source-nord.css | 44 ++++++++++ assets/source.css | 86 ------------------- .../Syntax/Concrete/Scoped/Pretty/Html.hs | 37 +++++--- 5 files changed, 130 insertions(+), 100 deletions(-) create mode 100644 assets/source-ayu-light.css create mode 100644 assets/source-nord.css delete mode 100644 assets/source.css diff --git a/app/Main.hs b/app/Main.hs index 10a0f39aa..eabe9ba56 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -36,7 +36,8 @@ data ParseOptions = ParseOptions data HtmlOptions = HtmlOptions { _htmlInputFile :: FilePath, - _htmlRecursive :: Bool + _htmlRecursive :: Bool, + _htmlTheme :: Theme } parseHtml :: Parser HtmlOptions @@ -52,8 +53,20 @@ parseHtml = do ( long "recursive" <> help "export imported modules recursively" ) - + _htmlTheme <- option (eitherReader parseTheme) + ( long "theme" + <> metavar "THEME" + <> value Nord + <> showDefault + <> help "selects a theme: ayu (light); nord (dark)" + ) pure HtmlOptions {..} + where + parseTheme :: String -> Either String Theme + parseTheme s = case s of + "nord" -> Right Nord + "ayu" -> Right Ayu + _ -> Left $ "unrecognised theme: " <> s parseParse :: Parser ParseOptions parseParse = do @@ -178,7 +191,7 @@ go c = case c of root <- getCurrentDirectory m <- parseModuleIO _htmlInputFile s <- fromRightIO show $ M.scopeCheck1 root m - genHtml defaultOptions _htmlRecursive s + genHtml defaultOptions _htmlRecursive _htmlTheme s main :: IO () main = execParser descr >>= go diff --git a/assets/source-ayu-light.css b/assets/source-ayu-light.css new file mode 100644 index 000000000..3a804ffd5 --- /dev/null +++ b/assets/source-ayu-light.css @@ -0,0 +1,44 @@ +/* Color palette based on https://github.com/ayu-theme/ayu-colors */ +body { + background-color: #f8f9fa; +} + +.ju-inductive { + color: #86b300; +} + +.ju-constructor { + color: #a37acc; +} + +.ju-function { + color: #f2ae49; +} + +.ju-axiom { + color: #f07171; +} + +.ju-keyword { + color: #399ee6; +} + +.ju-delimiter { + color: #787b80; +} + +.ju-var { + color: #5c6166; +} + +.ju-number { + color: #000000; +} + +a:hover, a.hover-highlight { + background-color: #dadbdc ; +} + +a:link, a:visited { + text-decoration: none; +} diff --git a/assets/source-nord.css b/assets/source-nord.css new file mode 100644 index 000000000..0cff1105e --- /dev/null +++ b/assets/source-nord.css @@ -0,0 +1,44 @@ +/* Color palette based on https://www.nordtheme.com/ */ +body { + background-color: #2e3440; +} + +.ju-inductive { + color: #a3be8c; +} + +.ju-constructor { + color: #b48ead; +} + +.ju-function { + color: #ebcb8b; +} + +.ju-axiom { + color: #bf616a; +} + +.ju-keyword { + color: #81a1c1; +} + +.ju-delimiter { + color: #5e81ac; +} + +.ju-var { + color: #d8dee9 +} + +.ju-number { + color: #d8dee9 +} + +a:link, a:visited { + text-decoration: none; +} + +a:hover, a.hover-highlight { + background-color: #4c566a; +} diff --git a/assets/source.css b/assets/source.css deleted file mode 100644 index 63d6d6b31..000000000 --- a/assets/source.css +++ /dev/null @@ -1,86 +0,0 @@ -/* Color palette based on https://www.nordtheme.com/ */ -body { - background-color: #2e3440; -} - -.ju-inductive { - color: #a3be8c; -} - -.ju-constructor { - color: #b48ead; -} - -.ju-function { - color: #ebcb8b; -} - -.ju-axiom { - color: #bf616a; -} - -.ju-keyword { - color: #81a1c1; -} - -.ju-delimiter { - color: #5e81ac; -} - -.ju-var { - color: #d8dee9 -} - -.ju-number { - color: #d8dee9 -} - -a:link, a:visited { - text-decoration: none; -} - -a:hover, a.hover-highlight { - background-color: #4c566a; -} - -span.annot{ - position:relative; - color:#000; - text-decoration:none - } - -span.annot:hover{z-index:25; background-color:#ff0} - -span.annot span.annottext{ - display: none; - border-radius: 5px 5px; - - -moz-border-radius: 5px; - -webkit-border-radius: 5px; - - box-shadow: 5px 5px 5px rgba(0, 0, 0, 0.1); - -webkit-box-shadow: 5px 5px rgba(0, 0, 0, 0.1); - -moz-box-shadow: 5px 5px rgba(0, 0, 0, 0.1); - - position: absolute; - left: 1em; top: 2em; - z-index: 99; - margin-left: 5; - background: #FFFFAA; - border: 2px solid #FFAD33; - padding: 0.8em 1em; -} - -span.annot:hover span.annottext{ - display:block; -} - -/* This bridges the gap so you can mouse into the tooltip without it disappearing */ -span.annot span.annottext:before{ - content: ""; - position: absolute; - left: -1em; top: -1em; - background: #FFFFFF00; - z-index:-1; - padding: 2em 2em; -} diff --git a/src/MiniJuvix/Syntax/Concrete/Scoped/Pretty/Html.hs b/src/MiniJuvix/Syntax/Concrete/Scoped/Pretty/Html.hs index f0188ebf8..2ad21e3e7 100644 --- a/src/MiniJuvix/Syntax/Concrete/Scoped/Pretty/Html.hs +++ b/src/MiniJuvix/Syntax/Concrete/Scoped/Pretty/Html.hs @@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} -module MiniJuvix.Syntax.Concrete.Scoped.Pretty.Html (genHtml) where +module MiniJuvix.Syntax.Concrete.Scoped.Pretty.Html (genHtml, Theme(..)) where import MiniJuvix.Syntax.Concrete.Language import MiniJuvix.Syntax.Concrete.Scoped.Utils @@ -16,9 +16,13 @@ import Data.Text.Lazy (toStrict) import qualified MiniJuvix.Syntax.Concrete.Scoped.Name as S import MiniJuvix.Utils.Paths +data Theme = + Nord + | Ayu + deriving stock (Show) -genHtml :: Options -> Bool -> Module 'Scoped 'ModuleTop -> IO () -genHtml opts recursive entry = do +genHtml :: Options -> Bool -> Theme -> Module 'Scoped 'ModuleTop -> IO () +genHtml opts recursive theme entry = do createDirectoryIfMissing True htmlPath copyAssetFiles withCurrentDirectory htmlPath $ do @@ -26,7 +30,7 @@ genHtml opts recursive entry = do where allModules | recursive = toList $ getAllModules entry - | otherwise = pure entry + | otherwise = pure entry htmlPath = "html" copyAssetFiles :: IO () @@ -38,23 +42,28 @@ genHtml opts recursive entry = do toAssetsDir = htmlPath "assets" cpFile (fromDir, name, toDir) = copyFile (fromDir name) (toDir name) assetFiles = [ (fromAssetsDir, name, toAssetsDir) - | name <- ["highlight.js" , "source.css"]] + | name <- ["highlight.js" + , "source-ayu-light.css" + , "source-nord.css"]] outputModule :: Module 'Scoped 'ModuleTop -> IO () outputModule m = do createDirectoryIfMissing True (takeDirectory htmlFile) putStrLn $ "Writing " <> htmlFile - Text.writeFile htmlFile (genModule opts m) + Text.writeFile htmlFile (genModule opts theme m) where htmlFile = dottedPath (S._nameConcrete (modulePath m)) <.> ".html" -genModule :: Options -> Module 'Scoped 'ModuleTop -> Text -genModule opts m = +genModule :: Options -> Theme -> Module 'Scoped 'ModuleTop -> Text +genModule opts theme m = toStrict $ Html.renderHtml $ docTypeHtml ! Attr.xmlns "http://www.w3.org/1999/xhtml" $ mhead <> mbody where + themeCss = case theme of + Ayu -> ayuCss + Nord -> nordCss prettySrc = (pre ! Attr.id "src-content") $ renderTree $ treeForm $ docStream opts m @@ -65,7 +74,7 @@ genModule opts m = mhead :: Html mhead = metaUtf8 - <> sourceCss + <> themeCss <> highlightJs mbody :: Html mbody = @@ -134,11 +143,17 @@ nameIdAttrRef :: TopModulePath -> S.NameId -> AttributeValue nameIdAttrRef tp s = dottedPath tp <> ".html" <> preEscapedToValue '#' <> nameIdAttr s -sourceCss :: Html -sourceCss = link ! Attr.href "assets/source.css" +cssLink :: AttributeValue -> Html +cssLink css = link ! Attr.href css ! Attr.rel "stylesheet" ! Attr.type_ "text/css" +ayuCss :: Html +ayuCss = cssLink "assets/source-ayu-light.css" + +nordCss :: Html +nordCss = cssLink "assets/source-nord.css" + highlightJs :: Html highlightJs = script ! Attr.src "assets/highlight.js" ! Attr.type_ "text/javascript"