diff --git a/src/Tintin.hs b/src/Tintin.hs --- a/src/Tintin.hs +++ b/src/Tintin.hs @@ -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") diff --git a/src/Tintin/Capabilities/Filesystem.hs b/src/Tintin/Capabilities/Filesystem.hs --- a/src/Tintin/Capabilities/Filesystem.hs +++ b/src/Tintin/Capabilities/Filesystem.hs @@ -56,8 +56,8 @@ _currentDirectory = getCurrentDirectory - |$> toText - |$> Path + & fmap toText + & fmap Path _readFile (Path p) = Core.readFile (toString p) diff --git a/src/Tintin/ConfigurationLoading.hs b/src/Tintin/ConfigurationLoading.hs --- a/src/Tintin/ConfigurationLoading.hs +++ b/src/Tintin/ConfigurationLoading.hs @@ -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 diff --git a/src/Tintin/Core.hs b/src/Tintin/Core.hs --- a/src/Tintin/Core.hs +++ b/src/Tintin/Core.hs @@ -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 = (=<<) diff --git a/src/Tintin/Domain/DocumentationFile.hs b/src/Tintin/Domain/DocumentationFile.hs --- a/src/Tintin/Domain/DocumentationFile.hs +++ b/src/Tintin/Domain/DocumentationFile.hs @@ -37,6 +37,6 @@ parse txt = encodeUtf8 @Text @ByteString txt - |> FMParser.parseYamlFrontmatter + & FMParser.parseYamlFrontmatter diff --git a/src/Tintin/Domain/HtmlFile.hs b/src/Tintin/Domain/HtmlFile.hs --- a/src/Tintin/Domain/HtmlFile.hs +++ b/src/Tintin/Domain/HtmlFile.hs @@ -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 diff --git a/src/Tintin/Errors.hs b/src/Tintin/Errors.hs --- a/src/Tintin/Errors.hs +++ b/src/Tintin/Errors.hs @@ -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." 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 @@ -239,6 +239,6 @@ bgColorOf :: Project.Info -> Text bgColorOf info = Project.color info - |> show - |> Text.toLower + & show + & Text.toLower diff --git a/src/Tintin/Parse.hs b/src/Tintin/Parse.hs --- a/src/Tintin/Parse.hs +++ b/src/Tintin/Parse.hs @@ -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 diff --git a/src/Tintin/Render.hs b/src/Tintin/Render.hs --- a/src/Tintin/Render.hs +++ b/src/Tintin/Render.hs @@ -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 diff --git a/tintin.cabal b/tintin.cabal --- a/tintin.cabal +++ b/tintin.cabal @@ -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 category: Documentation