tintin 1.2.5 → 1.3.5
raw patch · 14 files changed
+166/−128 lines, 14 filesdep +require
Dependencies added: require
Files
- src/Tintin.hs +6/−6
- src/Tintin/Capabilities/Filesystem.hs +5/−2
- src/Tintin/Capabilities/Logging.hs +3/−1
- src/Tintin/Capabilities/Process.hs +4/−1
- src/Tintin/ConfigurationLoading.hs +16/−10
- src/Tintin/Domain/DocumentationFile.hs +6/−6
- src/Tintin/Domain/HtmlFile.hs +13/−15
- src/Tintin/Domain/Project.hs +3/−0
- src/Tintin/Errors.hs +4/−2
- src/Tintin/Html/Style.hs +2/−0
- src/Tintin/Html/Templating.hs +70/−62
- src/Tintin/Parse.hs +12/−8
- src/Tintin/Render.hs +14/−11
- tintin.cabal +8/−4
src/Tintin.hs view
@@ -5,12 +5,12 @@ import Tintin.Core -import qualified Tintin.Capabilities.Logging as Logging-import qualified Tintin.Capabilities.Filesystem as Filesystem-import qualified Tintin.Capabilities.Process as Process-import qualified Tintin.Parse as Parse-import qualified Tintin.Render as Render-import qualified Tintin.ConfigurationLoading as ConfigurationLoading+require Tintin.Capabilities.Logging+require Tintin.Capabilities.Filesystem+require Tintin.Capabilities.Process+require Tintin.Parse+require Tintin.Render+require Tintin.ConfigurationLoading runApp :: ( Has Logging.Capability eff
src/Tintin/Capabilities/Filesystem.hs view
@@ -1,5 +1,6 @@ module Tintin.Capabilities.Filesystem- ( Capability+ ( Filesystem+ , Capability , Path(..) , Extension(..) @@ -20,8 +21,10 @@ import qualified Tintin.Core as Core import Tintin.Capabilities -import qualified Data.Text as Text+require Data.Text ++data Filesystem newtype Path = Path Text deriving ( Show, Ord, Eq ) newtype Extension = Extension Text
src/Tintin/Capabilities/Logging.hs view
@@ -1,5 +1,6 @@ module Tintin.Capabilities.Logging- ( Capability+ ( Logging+ , Capability , log , err , debug@@ -12,6 +13,7 @@ import Tintin.Core import Tintin.Capabilities +data Logging {- | Capability for our context to be able to log from any place where it is available:
src/Tintin/Capabilities/Process.hs view
@@ -1,5 +1,6 @@ module Tintin.Capabilities.Process- ( Capability+ ( Process+ , Capability , CommandName(..) , Arguments(..) , StdOut(..)@@ -15,6 +16,8 @@ import System.Exit (ExitCode(..)) ++data Process newtype CommandName = CommandName Text newtype Arguments = Arguments [Text]
src/Tintin/ConfigurationLoading.hs view
@@ -1,26 +1,32 @@ module Tintin.ConfigurationLoading- ( loadInfo )+ ( ConfigurationLoading+ , loadInfo+ ) where -import Tintin.Core-import qualified Tintin.Errors as Errors-import qualified Tintin.Capabilities.Logging as Logging-import qualified Tintin.Capabilities.Filesystem as Filesystem-import qualified Tintin.Domain.HtmlFile as HtmlFile-import qualified Tintin.Domain.Project as Project+require Tintin.Errors+require Tintin.Capabilities.Logging+require Tintin.Capabilities.Filesystem+require Tintin.Domain.HtmlFile+require Tintin.Domain.Project -import qualified Data.Text as Text+require Data.Text++import Tintin.Core import Universum.Unsafe (fromJust) import Text.Read (read) ++data ConfigurationLoading+ loadInfo :: ( Has Logging.Capability eff , Has Filesystem.Capability eff )- => [HtmlFile.Value]+ => [HtmlFile] -> Effectful eff Project.Info loadInfo htmlFiles = do let pages = htmlFiles- |> map (\HtmlFile.Value {..} -> Project.Page title content filename)+ |> map (\HtmlFile.HtmlFile {..} -> Project.Page title content filename) Filesystem.Path currentDir <- Filesystem.currentDirectory files <- Filesystem.list (Filesystem.Path currentDir) let packageYamlFile = find isPackageYaml files
src/Tintin/Domain/DocumentationFile.hs view
@@ -1,23 +1,23 @@ module Tintin.Domain.DocumentationFile where -import Tintin.Core- import qualified Data.Frontmatter as FMParser -import Tintin.Domain.FrontMatter as FrontMatter+import Tintin.Core +require Tintin.Domain.FrontMatter + newtype Filename = Filename Text newtype ParseError = ParseError Text deriving Show -data Value = Value+data DocumentationFile = DocumentationFile { filename :: Text , content :: Text , frontMatter :: FrontMatter } deriving Show -new :: Filename -> Text -> Either ParseError Value+new :: Filename -> Text -> Either ParseError DocumentationFile new (Filename filename) rawText = case parse rawText of FMParser.Fail _ _ err ->@@ -27,7 +27,7 @@ ) FMParser.Done source frontMatter ->- Right $ Value+ Right $ DocumentationFile { filename = filename , content = decodeUtf8 @Text @ByteString source , frontMatter = frontMatter
src/Tintin/Domain/HtmlFile.hs view
@@ -1,29 +1,28 @@ module Tintin.Domain.HtmlFile where import Tintin.Core-import qualified Tintin.Capabilities.Filesystem as Filesystem-import qualified Tintin.Capabilities.Process as Process-import qualified Tintin.Domain.DocumentationFile as DocumentationFile-import qualified Tintin.Domain.FrontMatter as FrontMatter--import qualified Data.Text as Text+require Tintin.Capabilities.Filesystem+require Tintin.Capabilities.Process+require Tintin.Domain.DocumentationFile+require Tintin.Domain.FrontMatter+require Data.Text newtype CompilationError = CompilationError Text deriving Show -data Value = Value+data HtmlFile = HtmlFile { filename :: Text , title :: Text , content :: Text } -fromDocumentationFile :: DocumentationFile.Value- -> Value+fromDocumentationFile :: DocumentationFile+ -> HtmlFile fromDocumentationFile docfile = DocumentationFile.content docfile |> ("{-# OPTIONS_GHC -F -pgmF inlitpp #-}\n" <>)- |> Value (DocumentationFile.filename docfile) docTitle+ |> HtmlFile (DocumentationFile.filename docfile) docTitle where docTitle = docfile |> DocumentationFile.frontMatter |> FrontMatter.title @@ -31,9 +30,9 @@ run :: ( Has Filesystem.Capability eff , Has Process.Capability eff )- => Value- -> Effectful eff (Either CompilationError Value)-run Value {..} = do+ => HtmlFile+ -> Effectful eff (Either CompilationError HtmlFile)+run HtmlFile {..} = do Filesystem.Path currentDirectory <- Filesystem.currentDirectory let tintinDir = currentDirectory <> "/.stack-work/tintin/" let tempDir = tintinDir <> "temp/"@@ -59,10 +58,9 @@ return (Left $ CompilationError err) Right (Process.StdOut msg) ->- return . Right $ Value+ return . Right $ HtmlFile { filename = htmlFilename , content = msg , title = title }-
src/Tintin/Domain/Project.hs view
@@ -2,6 +2,9 @@ import Tintin.Core ++data Project+ data Color = Purple | LightGreen
src/Tintin/Errors.hs view
@@ -1,11 +1,13 @@ module Tintin.Errors- ( showAndDie+ ( Errors+ , showAndDie ) where import Tintin.Core-import qualified Tintin.Capabilities.Logging as Logging+require Tintin.Capabilities.Logging +data Errors showAndDie :: ( Has Logging.Capability eff , Show error
src/Tintin/Html/Style.hs view
@@ -5,6 +5,8 @@ import Clay import qualified Clay.Media as Media +data Style+ style :: Text style = toText . render $ do html ? do
src/Tintin/Html/Templating.hs view
@@ -3,12 +3,14 @@ import Lucid import Tintin.Core-import qualified Tintin.Html.Style as Style-import qualified Tintin.Domain.Project as Project+require Tintin.Html.Style+require Tintin.Domain.Project -import qualified Data.Text as Text+require Data.Text +data Templating + asset :: Text -> Text asset txt = "https://s3-eu-west-1.amazonaws.com/worldwideapps/assets/" <> txt @@ -21,42 +23,43 @@ wrapPage :: Project.Info -> Project.Page -> Text wrapPage info page = toText . renderText $ do- tintinHeader info page- body_ [class_ "h-100 tintin-fg-black tintin-bg-white"] $ do- 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_ [ class_ "h-100 tintin-bg-70"] ( p_ "" )- ul_ [ class_ "sidebar-nav"] $ do- li_ [ class_ $ "sidebar-brand d-flex tintin-bg-" <> bgColorOf info] $ do- a_ [href_ "index.html", class_ "align-self-center tintin-fg-white"] $ do- case Project.logoUrl info of- Nothing -> toHtml $ Project.name info- Just url -> img_ [src_ url]- forM_ (filter (\p -> "index.html" /= Project.filename p ) (Project.pages info) ) $ \p -> do- li_ $ do- let classes =- if Project.title page == Project.title p- then "tintin-fg-active"- else "tintin-fg-disabled"- a_ [href_ $ Project.filename p, class_ classes] $ do- ( toHtml $ Project.title p )+ doctypehtml_ $ do+ tintinHeader info page+ body_ [class_ "h-100 tintin-fg-black tintin-bg-white"] $ do+ 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_ [ class_ "h-100 tintin-bg-70"] ( p_ "" )+ ul_ [ class_ "sidebar-nav"] $ do+ li_ [ class_ $ "sidebar-brand d-flex tintin-bg-" <> bgColorOf info] $ do+ a_ [href_ "index.html", class_ "align-self-center tintin-fg-white"] $ do+ case Project.logoUrl info of+ Nothing -> toHtml $ Project.name info+ Just url -> img_ [src_ url]+ forM_ (filter (\p -> "index.html" /= Project.filename p ) (Project.pages info) ) $ \p -> do+ li_ $ do+ let classes =+ if Project.title page == Project.title p+ then "tintin-fg-active"+ else "tintin-fg-disabled"+ a_ [href_ $ Project.filename p, class_ classes] $ do+ ( toHtml $ Project.title p ) - nav_ [class_ "navbar navbar-expand-lg tintin-doc-topbar tintin-fg-white"] $ do- a_ [id_ "menu-toggle", href_ "#menu-toggle", class_ ""] $ do- img_ [ src_ $ asset "menu.png", class_ "img-fluid animated rotateOut" ]- img_ [ src_ $ asset "close.png", class_ "img-fluid animated rotateIn" ]+ nav_ [class_ "navbar navbar-expand-lg tintin-doc-topbar tintin-fg-white"] $ do+ a_ [id_ "menu-toggle", href_ "#menu-toggle", class_ ""] $ do+ img_ [ src_ $ asset "menu.png", class_ "img-fluid animated rotateOut" ]+ img_ [ src_ $ asset "close.png", class_ "img-fluid animated rotateIn" ] - div_ [id_ "page-content-wrapper"] $ do- div_ [class_ "container"] $ do- div_ [class_ "col"] $- div_ [ class_ "animated fadeIn"- ] $- toHtmlRaw $ Project.content page- div_ [class_ "tintin-doc-footer clear-fix"]- siteGenerated- tintinPostInit+ div_ [id_ "page-content-wrapper"] $ do+ div_ [class_ "container"] $ do+ div_ [class_ "col"] $+ div_ [ class_ "animated fadeIn"+ ] $+ toHtmlRaw $ Project.content page+ div_ [class_ "tintin-doc-footer clear-fix"]+ siteGenerated+ tintinPostInit siteGenerated = do div_ [class_ "float-right"] $ do@@ -72,32 +75,33 @@ wrapHome :: Project.Info -> Project.Page -> Text wrapHome info page = toText . renderText $ do- tintinHeader info page- body_ [class_ "tintin-fg-black tintin-bg-white"] $ do+ doctypehtml_ $ do+ tintinHeader info page+ body_ [class_ "tintin-fg-black tintin-bg-white"] $ do - div_ [class_ $ "tintin-navigation tintin-bg-" <> bgColorOf 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- div_ [class_ "row align-items-center"] $ do- div_ [class_ "col", id_ "header-container"] $ do- case Project.logoUrl info of- Just url -> img_ [ src_ url, class_ "cover-heading" ]- Nothing -> h1_ [class_ "cover-heading"] $ toHtml (Project.name info)- p_ [class_ "cover-heading-subtitle"] (toHtml $ Project.synopsis info)+ div_ [class_ $ "tintin-navigation tintin-bg-" <> bgColorOf 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+ div_ [class_ "row align-items-center"] $ do+ div_ [class_ "col", id_ "header-container"] $ do+ case Project.logoUrl info of+ Just url -> img_ [ src_ url, class_ "cover-heading" ]+ Nothing -> h1_ [class_ "cover-heading"] $ toHtml (Project.name info)+ p_ [class_ "cover-heading-subtitle"] (toHtml $ Project.synopsis info) - navbar+ navbar - section_ [ id_ "content"- , class_ "animated fadeIn"- ] $ do- div_ [class_ "container"] $ do- div_ [class_ "content"- ] $- div_ [] $ do- toHtmlRaw $ Project.content page- footer- tintinPostInit+ section_ [ id_ "content"+ , class_ "animated fadeIn"+ ] $ do+ div_ [class_ "container"] $ do+ div_ [class_ "content"+ ] $+ div_ [] $ do+ toHtmlRaw $ Project.content page+ footer+ tintinPostInit where navbar = nav_ [ class_ "tintin-navbar"@@ -152,6 +156,9 @@ <> ".ico" ) ]+ link_ [ rel_ "stylesheet"+ , href_ "https://cdn.jsdelivr.net/npm/katex@0.10.0-alpha/dist/katex.min.css"+ ] style_ Style.style @@ -169,8 +176,9 @@ \$(\"#wrapper\").toggleClass(\"toggled\");\ \$(\"#menu-toggle img\").toggleClass(\"rotateIn rotateOut\");\ \})});"--+ 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
src/Tintin/Parse.hs view
@@ -1,20 +1,24 @@ module Tintin.Parse- ( docs )+ ( Parse+ , docs+ ) where -import Tintin.Core-import qualified Tintin.Capabilities.Logging as Logging-import qualified Tintin.Capabilities.Filesystem as Filesystem-import qualified Tintin.Domain.DocumentationFile as DocumentationFile-import qualified Tintin.Errors as Errors+import Tintin.Core+require Tintin.Capabilities.Logging+require Tintin.Capabilities.Filesystem+require Tintin.Domain.DocumentationFile+require Tintin.Errors +data Parse+ docs :: ( Has Logging.Capability eff , Has Filesystem.Capability eff ) => DocumentationDirectory -> [Filesystem.Path]- -> Effectful eff [DocumentationFile.Value]+ -> Effectful eff [DocumentationFile] docs docDir filenames = do Logging.debug "Parsing documentation" (errors, docFiles) <- filenames@@ -29,7 +33,7 @@ ) => DocumentationDirectory -> Filesystem.Path- -> Effectful eff (Either DocumentationFile.ParseError DocumentationFile.Value)+ -> Effectful eff (Either DocumentationFile.ParseError DocumentationFile) readAndParse ( DocumentationDirectory d ) ( Filesystem.Path f ) = do contents <- Filesystem.readFile ( Filesystem.Path $ d <> "/" <> f) return $ DocumentationFile.new (DocumentationFile.Filename f) contents
src/Tintin/Render.hs view
@@ -1,23 +1,26 @@ module Tintin.Render where import Tintin.Core-import Tintin.Capabilities.Logging as Logging-import Tintin.Capabilities.Filesystem as Filesystem-import Tintin.Capabilities.Process as Process-import Tintin.Domain.HtmlFile as HtmlFile-import Tintin.Domain.DocumentationFile as DocumentationFile-import Tintin.Domain.Project as Project-import Tintin.Html.Templating as Templating-import Tintin.Errors as Errors -import qualified Data.Text as Text+require Tintin.Capabilities.Logging+require Tintin.Capabilities.Filesystem+require Tintin.Capabilities.Process+require Tintin.Domain.HtmlFile+require Tintin.Domain.DocumentationFile+require Tintin.Domain.Project+require Tintin.Html.Templating+require Tintin.Errors +require Data.Text++data Render+ perform :: ( Has Logging.Capability eff , Has Filesystem.Capability eff , Has Process.Capability eff )- => [DocumentationFile.Value]- -> Effectful eff [HtmlFile.Value]+ => [DocumentationFile]+ -> Effectful eff [HtmlFile] perform docFiles = do Logging.debug "Rendering" (errors, htmlFiles) <- docFiles
tintin.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: aac6aa660721e65e4046c3563a1de2ca23e81ded206a1dfffabb866002f81acb+-- hash: 0c88129c3e8eba05edbef963e56ee9c022f21ba1b8e8d302f1168a007e6f995b name: tintin-version: 1.2.5+version: 1.3.5 synopsis: A softer alternative to Haddock description: Please see the website <https://theam.github.io/tintin> category: Documentation@@ -51,6 +51,7 @@ hs-source-dirs: src default-extensions: DeriveGeneric RecordWildCards OverloadedStrings DataKinds TypeOperators NoImplicitPrelude StandaloneDeriving TypeApplications KindSignatures FlexibleContexts FlexibleInstances MultiParamTypeClasses TypeFamilies+ ghc-options: -F -pgmF requirepp build-depends: base >=4.7 && <5 , clay@@ -60,6 +61,7 @@ , inliterate , lucid , process+ , require , temporary , text , universum@@ -73,10 +75,11 @@ hs-source-dirs: app default-extensions: DeriveGeneric RecordWildCards OverloadedStrings DataKinds TypeOperators NoImplicitPrelude StandaloneDeriving TypeApplications KindSignatures FlexibleContexts FlexibleInstances MultiParamTypeClasses TypeFamilies- ghc-options: -threaded -rtsopts -with-rtsopts=-N+ ghc-options: -F -pgmF requirepp -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 , optparse-generic+ , require , tintin , universum default-language: Haskell2010@@ -89,8 +92,9 @@ hs-source-dirs: test default-extensions: DeriveGeneric RecordWildCards OverloadedStrings DataKinds TypeOperators NoImplicitPrelude StandaloneDeriving TypeApplications KindSignatures FlexibleContexts FlexibleInstances MultiParamTypeClasses TypeFamilies- ghc-options: -threaded -rtsopts -with-rtsopts=-N+ ghc-options: -F -pgmF requirepp -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5+ , require , tintin default-language: Haskell2010