tintin 1.9.5 → 1.10.0

raw patch · 7 files changed

+189/−148 lines, 7 filesdep +inflectionsPVP ok

version bump matches the API change (PVP)

Dependencies added: inflections

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−1
• README.md +1/−0
• src/Tintin/ConfigurationLoading.hs +112/−93
• src/Tintin/Domain/Project.hs +11/−7
• src/Tintin/Html/Style.hs +32/−30
• src/Tintin/Html/Templating.hs +20/−12
• tintin.cabal +7/−5

@@ -1,3 +1,8 @@ # Changelog for tintin -## Unreleased changes+## 1.10.0++* Custom colors+* Custom google font+* Custom package defintion in tintin.yml+

@@ -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 

@@ -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)

@@ -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

@@ -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")-  ]

@@ -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

@@ -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 <https://theam.github.io/tintin> 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