tintin 1.9.4 → 1.9.5
raw patch · 11 files changed
+100/−89 lines, 11 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Tintin.Core: (|$>) :: Functor f => f a -> (a -> b) -> f b
- Tintin.Core: (|>) :: a -> (a -> b) -> b
- Tintin.Core: (|>>) :: Monad m => m a -> (a -> m b) -> m b
+ Tintin.Core: flatMap :: Monad m => (a -> m b) -> m a -> m b
Files
- src/Tintin.hs +11/−11
- src/Tintin/Capabilities/Filesystem.hs +2/−2
- src/Tintin/ConfigurationLoading.hs +45/−34
- src/Tintin/Core.hs +11/−11
- src/Tintin/Domain/DocumentationFile.hs +1/−1
- src/Tintin/Domain/HtmlFile.hs +10/−10
- src/Tintin/Errors.hs +2/−2
- src/Tintin/Html/Templating.hs +2/−2
- src/Tintin/Parse.hs +2/−2
- src/Tintin/Render.hs +12/−12
- tintin.cabal +2/−2
src/Tintin.hs view
@@ -28,12 +28,12 @@ publish (OutputDirectory p)= do gitContents <- Filesystem.readFile ( Filesystem.Path ".git/config" ) let r = lines gitContents- |> dropWhile (not . Text.isInfixOf "origin")- |> nonEmpty- |$> tail- |>> safeHead- |$> Text.dropWhile (/= '=')- |$> Text.dropWhile (/= 'g')+ & dropWhile (not . Text.isInfixOf "origin")+ & nonEmpty+ & fmap tail+ & flatMap safeHead+ & fmap (Text.dropWhile (/= '='))+ & fmap (Text.dropWhile (/= 'g')) case r of Nothing -> Errors.textDie ["Could not read origin remote. Are you in a Git repository?"]@@ -79,9 +79,9 @@ let buildTool = if shouldUseCabal then HtmlFile.Cabal else HtmlFile.Stack Parse.docs docDir filenames- |>> Render.perform buildTool- |>> ConfigurationLoading.loadInfo- |>> Render.writeOutput outputDirectory+ & flatMap (Render.perform buildTool)+ & flatMap (ConfigurationLoading.loadInfo)+ & flatMap (Render.writeOutput outputDirectory) cleanUp :: ( Has Logging.Capability eff@@ -103,8 +103,8 @@ getDocumentationFilenames (DocumentationDirectory docDir) = do Logging.debug ( "Reading documentation files at " <> docDir ) Filesystem.Path docDir- |> Filesystem.list- |$> Filesystem.getPathsWith (Filesystem.Extension ".md")+ & Filesystem.list+ & fmap (Filesystem.getPathsWith $ Filesystem.Extension ".md")
src/Tintin/Capabilities/Filesystem.hs view
@@ -56,8 +56,8 @@ _currentDirectory = getCurrentDirectory- |$> toText- |$> Path+ & fmap toText+ & fmap Path _readFile (Path p) = Core.readFile (toString p)
src/Tintin/ConfigurationLoading.hs view
@@ -26,7 +26,7 @@ -> Effectful eff Project.Info loadInfo htmlFiles = do let pages = htmlFiles- |> map (\HtmlFile.HtmlFile {..} -> 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@@ -45,13 +45,13 @@ 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 |$> getAuthor- tintinColor = tintinFile |> getFieldValue "color"- tintinLogo = tintinFile |> getFieldValue "logo"+ 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)@@ -82,40 +82,51 @@ makeColor :: Text -> Project.Color makeColor txt = let capitalLetter = txt- |> Text.head- |> Text.singleton- |> Text.toUpper+ & Text.head+ & Text.singleton+ & Text.toUpper restOfText = txt- |> Text.tail+ & Text.tail in (capitalLetter <> restOfText)- |> toString- |> read+ & toString+ & read getFieldValue field txt = txt- |> lines- |> filter (\t -> field `Text.isPrefixOf` Text.strip t)- |> safeHead- |$> Text.strip- |>> Text.stripPrefix (field <> ":")- |$> Text.strip+ & lines+ & filter (\t -> field `Text.isPrefixOf` Text.strip t)+ & safeHead+ & fmap Text.strip+ & flatMap (Text.stripPrefix $ field <> ":")+ & fmap Text.strip getAuthor txt =- txt- |> (Text.stripPrefix "\"" >=> Text.stripSuffix "\"")- |> fromMaybe txt- |> (\t -> if "http" `Text.isPrefixOf` t- then Text.splitOn "/" t- |> dropWhile (not . Text.isInfixOf "github")- |> Unsafe.tail- |> Unsafe.head- else t- )- |> Text.takeWhile (/= '/')+ 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 (/= '/') parseGithubUrl txt =+ let unquoted = stripGit $ stripQuotes txt+ in unquoted+ & Text.stripPrefix "github.com/"+ & fromMaybe unquoted++ stripQuotes txt = txt- |> Text.stripPrefix "\""- |>> Text.stripSuffix "\""- |> fromMaybe txt+ & Text.stripPrefix "\""+ & flatMap (Text.stripSuffix "\"")+ & fromMaybe txt + stripGit txt =+ txt+ & Text.stripPrefix "git://"+ & flatMap (Text.stripSuffix ".git")+ & fromMaybe txt
src/Tintin/Core.hs view
@@ -4,11 +4,8 @@ , Effectful , Pure - , (|>)- , (|$>)- , (|>>)- , runEffects+ , flatMap ) where @@ -35,11 +32,14 @@ Reader context result -(|>) :: a -> (a -> b) -> b-(|>) = (&)--(|$>) :: Functor f => f a -> (a -> b) -> f b-(|$>) = (<&>)+-- (|>) :: a -> (a -> b) -> b+-- (|>) = (&)+--+-- (|$>) :: Functor f => f a -> (a -> b) -> f b+-- (|$>) = (<&>)+--+-- (|>>) :: Monad m => m a -> (a -> m b) -> m b+-- (|>>) = (>>=) -(|>>) :: Monad m => m a -> (a -> m b) -> m b-(|>>) = (>>=)+flatMap :: Monad m => (a -> m b) -> m a -> m b+flatMap = (=<<)
src/Tintin/Domain/DocumentationFile.hs view
@@ -37,6 +37,6 @@ parse txt = encodeUtf8 @Text @ByteString txt- |> FMParser.parseYamlFrontmatter+ & FMParser.parseYamlFrontmatter
src/Tintin/Domain/HtmlFile.hs view
@@ -29,10 +29,10 @@ -> HtmlFile fromDocumentationFile docfile = DocumentationFile.content docfile- |> ("{-# OPTIONS_GHC -F -pgmF inlitpp #-}\n" <>)- |> HtmlFile (DocumentationFile.filename docfile) docTitle+ & ("{-# OPTIONS_GHC -F -pgmF inlitpp #-}\n" <>)+ & HtmlFile (DocumentationFile.filename docfile) docTitle where- docTitle = docfile |> DocumentationFile.frontMatter |> FrontMatter.title+ docTitle = docfile & DocumentationFile.frontMatter & FrontMatter.title run :: ( Has Filesystem.Capability eff@@ -46,14 +46,14 @@ let tintinDir = currentDirectory <> "/.stack-work/tintin/" let tempDir = tintinDir <> "temp/" let hsFilename = filename- |> Text.breakOn ".md"- |> fst- |> (<> ".hs")- |> (tempDir <>)+ & Text.breakOn ".md"+ & fst+ & (<> ".hs")+ & (tempDir <>) let htmlFilename = filename- |> Text.breakOn ".md"- |> fst- |> (<> ".html")+ & Text.breakOn ".md"+ & fst+ & (<> ".html") Filesystem.deleteIfExists (Filesystem.Path tempDir) Filesystem.makeDirectory (Filesystem.Path tempDir) Filesystem.writeFile (Filesystem.Path hsFilename) content
src/Tintin/Errors.hs view
@@ -18,7 +18,7 @@ -> Effectful eff () showAndDie errors = do errors- |> mapM_ (Logging.err . show)+ & mapM_ (Logging.err . show) die "Errors found. Exiting." textDie :: ( Has Logging.Capability eff@@ -27,6 +27,6 @@ -> Effectful eff () textDie errors = do errors- |> mapM_ Logging.err+ & mapM_ Logging.err die "Errors found. Exiting."
src/Tintin/Html/Templating.hs view
@@ -239,6 +239,6 @@ bgColorOf :: Project.Info -> Text bgColorOf info = Project.color info- |> show- |> Text.toLower+ & show+ & Text.toLower
src/Tintin/Parse.hs view
@@ -22,8 +22,8 @@ docs docDir filenames = do Logging.debug "Parsing documentation" (errors, docFiles) <- filenames- |> mapM (readAndParse docDir)- |$> partitionEithers+ & traverse (readAndParse docDir)+ & fmap partitionEithers unless (null errors) (Errors.showAndDie errors) return docFiles
src/Tintin/Render.hs view
@@ -26,9 +26,9 @@ perform buildTool docFiles = do Logging.debug "Rendering" (errors, htmlFiles) <- docFiles- |> map HtmlFile.fromDocumentationFile- |> mapM (HtmlFile.run buildTool)- |$> partitionEithers+ & map HtmlFile.fromDocumentationFile+ & mapM (HtmlFile.run buildTool)+ & fmap partitionEithers unless (null errors) (Errors.textDie (HtmlFile.showCompilationError <$> errors)) return htmlFiles @@ -82,8 +82,8 @@ -- alphabetical sorting. contextMap :: Map Text (Project.Page, Project.Context) contextMap = ps- |$> (\p -> (Project.filename p, (p, makeContext p)))- |> Map.fromList+ & fmap (\p -> (Project.filename p, (p, makeContext p)))+ & Map.fromList -- | Actual function that pairs up each page with its context (next and -- previous links). --@@ -96,16 +96,16 @@ makeContext :: Project.Page -> Project.Context makeContext p | fn == "index.html" = Map.lookupMin pageMap- |$> snd- |$> makeRef- |> Project.Context Nothing+ & fmap snd+ & fmap makeRef+ & Project.Context Nothing | otherwise = let prev = Map.lookupLT fn pageMap- |$> snd- |$> makeRef+ & fmap snd+ & fmap makeRef next = Map.lookupGT fn pageMap- |$> snd- |$> makeRef+ & fmap snd+ & fmap makeRef in Project.Context (prev <|> indexRef) next -- if no prev, use index where fn = Project.filename p
tintin.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 4c657f82bc965cbf8fec6422b0cb6c64572748f1bb8a86f415f88e61f0d76b4a+-- hash: 04d82d8cd97bfbed9c7ead4bc11eb1c6f629a0aaf9426a6b7a995dc0ebe32423 name: tintin-version: 1.9.4+version: 1.9.5 synopsis: A softer alternative to Haddock description: Please see the website <https://theam.github.io/tintin> category: Documentation