diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,8 @@ # Changelog for tintin -## Unreleased changes +## 1.10.0 + +* Custom colors +* Custom google font +* Custom package defintion in tintin.yml + diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -34,6 +34,7 @@ |-|-| |[Tintin](https://theam.github.io/tintin)| A softer alternative to Haddock | |[backprop](https://backprop.jle.im)| Heterogeneous automatic differentiation | +|[hedn](https://dpwiz.gitlab.io/hedn/)| EDN parsing and encoding | # Copyright diff --git a/src/Tintin/ConfigurationLoading.hs b/src/Tintin/ConfigurationLoading.hs --- a/src/Tintin/ConfigurationLoading.hs +++ b/src/Tintin/ConfigurationLoading.hs @@ -15,118 +15,137 @@ import Tintin.Core import qualified Universum.Unsafe as Unsafe import Text.Read (read) - +import qualified Text.Inflections as Inflections data ConfigurationLoading -loadInfo :: ( Has Logging.Capability eff - , Has Filesystem.Capability eff - ) - => [HtmlFile] - -> Effectful eff Project.Info -loadInfo htmlFiles = do - let pages = htmlFiles - & map (\HtmlFile.HtmlFile {..} -> Project.Page title content filename) - Filesystem.Path currentDir <- Filesystem.currentDirectory - files <- Filesystem.list (Filesystem.Path currentDir) +data ProjectContext = ProjectContext + { name :: Maybe Text + , synopsis :: Maybe Text + , github :: Maybe Text + , location :: Maybe Text + , author :: Maybe Text + , projectLocation :: Filesystem.Path + } + +getFieldValue :: Text -> Text -> Maybe Text +getFieldValue field txt = txt + & lines + & filter (\t -> field `Text.isPrefixOf` Text.strip t) + & safeHead + & fmap Text.strip + & flatMap (Text.stripPrefix $ field <> ":") + & fmap Text.strip + +loadProjectConfig :: ( Has Logging.Capability eff + , Has Filesystem.Capability eff + ) + => Filesystem.Path -> Effectful eff ProjectContext +loadProjectConfig currentPath = do + files <- Filesystem.list currentPath let packageYamlFile = find isPackageYaml files let cabalFile = find isCabalFile files case packageYamlFile <|> cabalFile of - Nothing -> do - Errors.showAndDie ["No package.yaml or *.cabal file found."] - error "" - - Just p -> do - let tintinPath = Filesystem.Path $ currentDir <> "/.tintin.yml" + Just file -> do Logging.debug "Reading project info" - projectInfoFile <- Filesystem.readFile p - tintinExists <- Filesystem.doesExist tintinPath - unless tintinExists $ - Filesystem.writeFile tintinPath "color: blue\n" - tintinFile <- Filesystem.readFile tintinPath - let - projectName = projectInfoFile & getFieldValue "name" - projectSynopsis = projectInfoFile & getFieldValue "synopsis" - projectGithub = (projectInfoFile & getFieldValue "github") - <|> (projectInfoFile & getFieldValue "location") - projectAuthor = projectGithub & fmap getAuthor - tintinColor = tintinFile & getFieldValue "color" - tintinLogo = tintinFile & getFieldValue "logo" - when (isNothing projectName) (Errors.showAndDie ["Project must have a name. Please set it in package.yaml or *.cabal."]) - when (isNothing projectSynopsis) (Errors.showAndDie ["Project must have a synopsis. Please set it in package.yaml or *.cabal."]) - when (isNothing tintinColor) - (Errors.showAndDie [errorMessages]) - return Project.Info - { name = Unsafe.fromJust projectName - , synopsis = Unsafe.fromJust projectSynopsis - , githubLink = parseGithubUrl <$> projectGithub - , githubAuthor = projectAuthor - , color = makeColor $ Unsafe.fromJust tintinColor - , logoUrl = tintinLogo - , pages = pages + projectConfigFile <- Filesystem.readFile file + return ProjectContext + { name = projectConfigFile & getFieldValue "name" + , synopsis = projectConfigFile & getFieldValue "synopsis" + , github = projectConfigFile & getFieldValue "github" + , location = projectConfigFile & getFieldValue "location" + , author = projectConfigFile & getFieldValue "author" + , projectLocation = currentPath } - + Nothing -> return ProjectContext + { name = Nothing + , synopsis = Nothing + , github = Nothing + , location = Nothing + , author = Nothing + , projectLocation = currentPath + } where - errorMessages = unlines - ["Tintin usually generates a .tintin.yml file with a color configuration. Maybe you don't have enough permissions?" - , "" - , "" - , "Try creating .tintin.yml and adding color:blue to it." - ] - isPackageYaml (Filesystem.Path p) = - p == "package.yaml" - - isCabalFile (Filesystem.Path p) = - ".cabal" `Text.isInfixOf` p - - makeColor :: Text -> Project.Color - makeColor txt = - let capitalLetter = txt - & Text.head - & Text.singleton - & Text.toUpper - restOfText = txt - & Text.tail - in (capitalLetter <> restOfText) - & toString - & read - - getFieldValue field txt = txt - & lines - & filter (\t -> field `Text.isPrefixOf` Text.strip t) - & safeHead - & fmap Text.strip - & flatMap (Text.stripPrefix $ field <> ":") - & fmap Text.strip - getAuthor txt = - let unquoted = stripQuotes txt - in parseGithubUrl unquoted - & (\t -> if "http" `Text.isPrefixOf` t - then Text.splitOn "/" t - & filter (not . Text.isInfixOf "git") - & filter (not . Text.null) - & Unsafe.tail - & Unsafe.head - else t - ) - & Text.takeWhile (/= '/') + isPackageYaml (Filesystem.Path p) = p == "package.yaml" + isCabalFile (Filesystem.Path p) = ".cabal" `Text.isInfixOf` p +loadTintinConfig :: ( Has Logging.Capability eff + , Has Filesystem.Capability eff + ) + => [Project.Page] + -> ProjectContext + -> Effectful eff Project.Info +loadTintinConfig pages ProjectContext {..} = do + let Filesystem.Path currentPath = projectLocation + tintinPath = Filesystem.Path $ currentPath <> "/.tintin.yml" + tintinExists <- Filesystem.doesExist tintinPath + unless tintinExists $ Filesystem.writeFile tintinPath "color: blue\n" + tintinConfig <- Filesystem.readFile tintinPath + let + projectName = (tintinConfig & getFieldValue "name") <|> name + projectSynopsis = (tintinConfig & getFieldValue "synopsis") <|> synopsis + projectGithub = (tintinConfig & getFieldValue "github") <|> github <|> location + projectAuthor = (tintinConfig & getFieldValue "author") <|> author + tintinColor = tintinConfig & getFieldValue "color" + tintinLogo = tintinConfig & getFieldValue "logo" + tintinTitleFont = (tintinConfig & getFieldValue "titleFont") <|> (Just $ fromString "Montserrat") + tintinTitleFontWeight = (tintinConfig & getFieldValue "titleFontWeight") <|> (Just "500") + tintinBodyFont = (tintinConfig & getFieldValue "bodyFont") <|> (Just $ fromString "IBM+Plex+Sans") + when (isNothing projectName) (Errors.showAndDie ["Project must have a name. Please set it in package.yaml or *.cabal."]) + when (isNothing projectSynopsis) (Errors.showAndDie ["Project must have a synopsis. Please set it in package.yaml or *.cabal."]) + when (isNothing tintinColor) (Errors.showAndDie [errorMessages]) + return Project.Info + { name = Unsafe.fromJust projectName + , synopsis = Unsafe.fromJust projectSynopsis + , githubLink = parseGithubUrl <$> projectGithub + , githubAuthor = projectAuthor + , color = makeColor $ Unsafe.fromJust tintinColor + , logoUrl = tintinLogo + , titleFont = Unsafe.fromJust tintinTitleFont + , titleFontWeight = read $ toString $ Unsafe.fromJust tintinTitleFontWeight + , bodyFont = Unsafe.fromJust tintinBodyFont + , pages = pages + } + where parseGithubUrl txt = let unquoted = stripGit $ stripQuotes txt in unquoted & Text.stripPrefix "github.com/" & fromMaybe unquoted - + stripGit txt = + txt + & Text.stripPrefix "git://" + & flatMap (Text.stripSuffix ".git") + & fromMaybe txt stripQuotes txt = txt & Text.stripPrefix "\"" & flatMap (Text.stripSuffix "\"") & fromMaybe txt - - stripGit txt = - txt - & Text.stripPrefix "git://" - & flatMap (Text.stripSuffix ".git") - & fromMaybe txt + errorMessages = unlines + ["Tintin usually generates a .tintin.yml file with a color configuration. Maybe you don't have enough permissions?" + , "" + , "" + , "Try creating .tintin.yml and adding color:blue to it." + ] +makeColor :: Text -> Project.Color +makeColor txt = + case Text.stripPrefix "#" txt of + Just _ -> Project.HexColor txt + Nothing -> Inflections.SomeWord <$> Inflections.mkWord txt + & Inflections.titleize + & toString + & read +loadInfo :: ( Has Logging.Capability eff + , Has Filesystem.Capability eff + ) + => [HtmlFile] + -> Effectful eff Project.Info +loadInfo htmlFiles = + Filesystem.currentDirectory + >>= loadProjectConfig + >>= loadTintinConfig pages + where + pages = htmlFiles & map (\HtmlFile.HtmlFile {..} -> Project.Page title content filename) diff --git a/src/Tintin/Domain/Project.hs b/src/Tintin/Domain/Project.hs --- a/src/Tintin/Domain/Project.hs +++ b/src/Tintin/Domain/Project.hs @@ -16,6 +16,7 @@ | LightOrange | Red | Grey + | HexColor Text deriving (Show, Read) @@ -27,13 +28,16 @@ data Info = Info - { name :: Text - , synopsis :: Text - , color :: Color - , githubLink :: Maybe Text - , githubAuthor :: Maybe Text - , logoUrl :: Maybe Text - , pages :: [Page] + { name :: Text + , synopsis :: Text + , color :: Color + , githubLink :: Maybe Text + , githubAuthor :: Maybe Text + , logoUrl :: Maybe Text + , titleFont :: Text + , titleFontWeight :: Integer + , bodyFont :: Text + , pages :: [Page] } data PageRef = PageRef diff --git a/src/Tintin/Html/Style.hs b/src/Tintin/Html/Style.hs --- a/src/Tintin/Html/Style.hs +++ b/src/Tintin/Html/Style.hs @@ -5,10 +5,13 @@ import Clay import qualified Clay.Media as Media +require Tintin.Domain.Project + data Style -style :: Text -style = toText . render $ do +style :: Project.Info -> Text +style info = toText . render $ do + let (themeColorName, themeColorCode) = themeColor $ Project.color info html ? do height (pct 100) minHeight (pct 100) @@ -16,19 +19,24 @@ body ? do height (pct 100) minHeight (pct 100) - fontFamily ["IBM Plex Sans"] [ sansSerif ] + fontFamily [Project.bodyFont info] [sansSerif] fontSize (em 1) overflowX hidden forM_ (zip [(0::Double)..] [h1, h2, h3]) $ \(n, x) -> x ? do - fontFamily ["Montserrat" ] [ sansSerif ] - fontWeight bold + fontFamily [Project.titleFont info] [sansSerif] + fontWeight $ weight $ Project.titleFontWeight info fontSize (em (2.441 Core.** n)) h1 ? fontSize (em 2.441) h2 ? fontSize (em 1.953) h3 ? fontSize (em 1.563) + blockquote ? do + borderLeft solid (px 4) "#DDD" + paddingLeft (rem 1) + color "#777" + ".next-prev" ? do marginTop (pct 5) marginBottom (pct 5) @@ -170,8 +178,8 @@ ".sidebar-nav" |> ".sidebar-brand" ? do height (rem 3) fontSize (rem 2) - fontFamily ["Montserrat"] [sansSerif] - fontWeight bold + fontFamily [Project.titleFont info] [sansSerif] + fontWeight $ weight $ Project.titleFontWeight info paddingTop (rem 2.5) paddingBottom (rem 2.5) marginBottom (rem 1.5) @@ -212,14 +220,12 @@ ".tintin-bg-70" ? do backgroundColor (rgba 255 255 255 0.15) - - forM colorNames $ \(colorName, colorValue) -> - (element $ ".tintin-bg-" <> colorName) ? do - backgroundColor colorValue + + (element $ ".tintin-bg-" <> themeColorName) ? do + backgroundColor themeColorCode - forM colorNames $ \(colorName, colorValue) -> - (element $ ".tintin-fg-" <> colorName) ? do - color colorValue + (element $ ".tintin-fg-" <> themeColorName) ? do + color themeColorCode ".tintin-fg-active" ? do color (rgba 255 255 255 1.0) @@ -260,20 +266,16 @@ position relative +themeColor :: Project.Color -> (Text, Color) +themeColor (Project.HexColor colorCode) = ("custom", fromString $ toString colorCode) +themeColor Project.Purple = ("purple" , "#9F76B4") +themeColor Project.LightGreen = ("lightgreen" , "#A4CB58") +themeColor Project.DarkGreen = ("darkgreen" , "#3C8B6A") +themeColor Project.Blue = ("blue" , "#94C1E8") +themeColor Project.DarkBlue = ("darkblue" , "#007C99") +themeColor Project.Bronze = ("bronze" , "#A4A27A") +themeColor Project.DarkOrange = ("darkorange" , "#FF6602") +themeColor Project.LightOrange = ("l ", "#FAA73E") +themeColor Project.Red = ("red" , "#D30228") +themeColor Project.Grey = ("grey" , "#4D4D4D") -colorNames :: [(Text, Color)] -colorNames = - [ ("black" , "#1d1f21") - , ("white" , "#f5f8f6") - , ("grey" , "#4D4D4D") - , ("red" , "#D30228") - , ("darkgreen" , "#3C8B6A") - , ("lightgreen" , "#A4CB58") - , ("darkorange" , "#FF6602") - , ("lightorange", "#FAA73E") - , ("blue" , "#94C1E8") - , ("darkblue" , "#007C99") - , ("purple" , "#9F76B4") - , ("bronze" , "#A4A27A") - , ("darkgrey" , "#282a2e") - ] diff --git a/src/Tintin/Html/Templating.hs b/src/Tintin/Html/Templating.hs --- a/src/Tintin/Html/Templating.hs +++ b/src/Tintin/Html/Templating.hs @@ -30,10 +30,10 @@ div_ [id_ "main-container", class_ "h-100"] $ do section_ [ id_ "content"] $ do div_ [id_ "wrapper", class_ "toggled"] $ do - div_ [id_ "sidebar-wrapper", class_ $ "h-100 tintin-bg-" <> bgColorOf info] $ do + div_ [id_ "sidebar-wrapper", class_ $ "h-100 tintin-bg-" <> bgColorNameOf info] $ do div_ [ class_ "h-100 tintin-bg-70"] ( p_ "" ) ul_ [ class_ "sidebar-nav"] $ do - li_ [ class_ $ "sidebar-brand d-flex tintin-bg-" <> bgColorOf info] $ do + li_ [ class_ $ "sidebar-brand d-flex tintin-bg-" <> bgColorNameOf info] $ do a_ [href_ "index.html", class_ "align-self-center tintin-fg-white"] $ do case Project.logoUrl info of Nothing -> toHtml $ Project.name info @@ -92,7 +92,7 @@ tintinHeader info page body_ [class_ "tintin-fg-black tintin-bg-white"] $ do - div_ [class_ $ "tintin-navigation tintin-bg-" <> bgColorOf info] $ do + div_ [class_ $ "tintin-navigation tintin-bg-" <> bgColorNameOf info] $ do div_ [class_ "cover-container d-flex p-3 mx-auto flex-column tintin-fg-white"] $ do main_ [role_ "main", class_ "masthead mb-auto"] $ do div_ [class_ "container"] $ do @@ -144,7 +144,7 @@ when (isJust $ Project.githubLink info) $ do "Developed by " a_ [ href_ $ "https://github.com/" <> (fromJust $ Project.githubAuthor info) - , class_ $ "tintin-fg-" <> bgColorOf info + , class_ $ "tintin-fg-" <> bgColorNameOf info ] (toHtml $ fromJust $ Project.githubAuthor info) div_ [class_ "col", style_ ""] $ do siteGenerated @@ -200,7 +200,7 @@ , content_ synopsis ] link_ [ rel_ "stylesheet" - , href_ "https://fonts.googleapis.com/css?family=IBM+Plex+Sans|Montserrat:500" + , href_ $ googleFontUrl info ] link_ [ rel_ "stylesheet" , href_ "https://maxcdn.bootstrapcdn.com/bootstrap/4.0.0/css/bootstrap.min.css" @@ -213,14 +213,14 @@ ] link_ [ rel_ "shortcut icon" , href_ ( asset $ "favicon-" - <> bgColorOf info + <> bgColorNameOf info <> ".ico" ) ] link_ [ rel_ "stylesheet" , href_ "https://cdn.jsdelivr.net/npm/katex@0.10.0-alpha/dist/katex.min.css" ] - style_ Style.style + style_ $ Style.style info tintinPostInit :: Html () @@ -236,9 +236,17 @@ script_ [src_ "https://cdn.jsdelivr.net/npm/katex@0.10.0-alpha/dist/katex.min.js"] ("" :: Text) script_ [src_ "https://cdnjs.cloudflare.com/ajax/libs/KaTeX/0.9.0/contrib/auto-render.min.js"] ("" :: Text) script_ "renderMathInElement(document.body);" -bgColorOf :: Project.Info -> Text -bgColorOf info = - Project.color info - & show - & Text.toLower +bgColorNameOf :: Project.Info -> Text +bgColorNameOf info = + case color of + Project.HexColor color -> fromString "custom" + _ -> color + & show + & Text.toLower + where color = Project.color info + + +googleFontUrl :: Project.Info -> Text +googleFontUrl Project.Info {..} = + "https://fonts.googleapis.com/css?family=" <> bodyFont <> "|" <> titleFont <> ":" <> show titleFontWeight diff --git a/tintin.cabal b/tintin.cabal --- a/tintin.cabal +++ b/tintin.cabal @@ -1,11 +1,13 @@ --- This file has been generated from package.yaml by hpack version 0.28.2. +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.31.1. -- -- see: https://github.com/sol/hpack -- --- hash: 04d82d8cd97bfbed9c7ead4bc11eb1c6f629a0aaf9426a6b7a995dc0ebe32423 +-- hash: 5809563abfa619872cbce79a1f04096fff76efea04b325cd64e797e4edc3b011 name: tintin -version: 1.9.5 +version: 1.10.0 synopsis: A softer alternative to Haddock description: Please see the website category: Documentation @@ -17,10 +19,9 @@ license: Apache-2.0 license-file: LICENSE.md build-type: Simple -cabal-version: >= 1.10 extra-source-files: - ChangeLog.md README.md + ChangeLog.md Requires source-repository head @@ -59,6 +60,7 @@ , data-has , directory , frontmatter + , inflections , inliterate , lucid , process