diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,19 @@ # Change Log for rib +## 0.10.0.0 + +- API + - Dropped `path` and `path-io` in favour of good ol' `FilePath` + - This also lifts the restriction with absolute paths +- Misc changes + - #145: CLI arguments have been revamped + - `serve` subcommand is replaced by the options `-wS`. + - Added `--input-dir/--output-dir` to override these paths + - Accept host string in addition to port number + - Exposed `Rib.Shake.getCliConfig` to get full CLI configuration + - Allow customizing fsnotify ignore list + - #141: Allow quiet logging (useful when rib is used as a library) + ## 0.8.0.0 - Dependency upgrades diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -![Logo](https://raw.githubusercontent.com/srid/rib/master/assets/rib.png) + # rib @@ -7,238 +7,23 @@ [![built with nix](https://img.shields.io/badge/builtwith-nix-purple.svg)](https://builtwithnix.org) [![Zulip chat](https://img.shields.io/badge/zulip-join_chat-brightgreen.svg)](https://funprog.zulipchat.com/#narrow/stream/218047-Rib) -Rib is a Haskell **static site generator** that aims to reuse existing libraries instead of reinventing the wheel. - -How does it compare to the popular static site generator Hakyll? - -- Uses the [Shake](https://shakebuild.com/) build system at its core. -- Write HTML ([Lucid](https://chrisdone.com/posts/lucid2/)) & CSS ([Clay](http://fvisser.nl/clay/)) in Haskell. -- Built-in support for [Pandoc](https://pandoc.org/) and [MMark](https://github.com/mmark-md/mmark). -- Remain as simple as possible to use (see example below) -- Nix-based environment for reproducibility -- `ghcid` and fsnotify for "hot reload" - -Rib prioritizes the use of *existing* tools over reinventing them, and enables -the user to compose them as they wish instead of having to write code to fit a -custom framework. - -**Table of Contents** - -- [Quick Preview](#quick-preview) -- [Getting Started](#getting-started) -- [Concepts](#concepts) - - [Directory structure](#directory-structure) - - [Run the site](#run-the-site) - - [How Rib works](#how-rib-works) - - [Editing workflow](#editing-workflow) - - [What's next?](#whats-next) -- [Examples](#examples) - -## Quick Preview - -Here is how your code may look like if you were to generate your static site -using Rib: - -```haskell --- | Route corresponding to each generated static page. --- --- The `a` parameter specifies the data (typically Markdown document) used to --- generate the final page text. -data Route a where - Route_Index :: Route [(Route Pandoc, Pandoc)] - Route_Article :: Path Rel File -> Route Pandoc - --- | The `IsRoute` instance allows us to determine the target .html path for --- each route. This affects what `routeUrl` will return. -instance IsRoute Route where - routeFile = \case - Route_Index -> - pure [relfile|index.html|] - Route_Article srcPath -> - fmap ([reldir|article|] ) $ - replaceExtension ".html" srcPath - --- | Main entry point to our generator. --- --- `Rib.run` handles CLI arguments, and takes three parameters here. --- --- 1. Directory `content`, from which static files will be read. --- 2. Directory `dest`, under which target files will be generated. --- 3. Shake action to run. --- --- In the shake action you would expect to use the utility functions --- provided by Rib to do the actual generation of your static site. -main :: IO () -main = withUtf8 $ do - Rib.run [reldir|content|] [reldir|dest|] generateSite +Rib is a Haskell **static site generator** based on Shake, with a delightful workflow. --- | Shake action for generating the static site -generateSite :: Action () -generateSite = do - -- Copy over the static files - Rib.buildStaticFiles [[relfile|static/**|]] - let writeHtmlRoute :: Route a -> a -> Action () - writeHtmlRoute r = Rib.writeRoute r . Lucid.renderText . renderPage r - -- Build individual sources, generating .html for each. - articles <- - Rib.forEvery [[relfile|*.md|]] $ \srcPath -> do - let r = Route_Article srcPath - doc <- Pandoc.parse Pandoc.readMarkdown srcPath - writeHtmlRoute r doc - pure (r, doc) - writeHtmlRoute Route_Index articles +See for full documentation. --- | Define your site HTML here -renderPage :: Route a -> a -> Html () -renderPage route val = html_ [lang_ "en"] $ do - head_ $ do - meta_ [httpEquiv_ "Content-Type", content_ "text/html; charset=utf-8"] - title_ routeTitle - style_ [type_ "text/css"] $ C.render pageStyle - body_ $ do - div_ [class_ "header"] $ - a_ [href_ "/"] "Back to Home" - h1_ routeTitle - case route of - Route_Index -> - div_ $ forM_ val $ \(r, src) -> - li_ [class_ "pages"] $ do - let meta = getMeta src - b_ $ a_ [href_ (Rib.routeUrl r)] $ toHtml $ title meta - renderMarkdown `mapM_` description meta - Route_Article _ -> - article_ $ - Pandoc.render val - where - routeTitle :: Html () - routeTitle = case route of - Route_Index -> "Rib sample site" - Route_Article _ -> toHtml $ title $ getMeta val - renderMarkdown :: Text -> Html () - renderMarkdown = - Pandoc.render . Pandoc.parsePure Pandoc.readMarkdown +## Developing rib --- | Define your site CSS here -pageStyle :: Css -pageStyle = C.body ? do - C.margin (em 4) (pc 20) (em 1) (pc 20) - ".header" ? do - C.marginBottom $ em 2 - "li.pages" ? do - C.listStyleType C.none - C.marginTop $ em 1 - "b" ? C.fontSize (em 1.2) - "p" ? sym C.margin (px 0) +Use ghcid for quicker compilation cycles: --- | Metadata in our markdown sources -data SrcMeta - = SrcMeta - { title :: Text, - -- | Description is optional, hence `Maybe` - description :: Maybe Text - } - deriving (Show, Eq, Generic, FromJSON) ``` - -(View full [`Main.hs`](https://github.com/srid/rib-sample/blob/master/src/Main.hs) at rib-sample) - -## Getting Started - -The easiest way to get started with [Rib](/) is to [use the -template](https://help.github.com/en/articles/creating-a-repository-from-a-template) -repository, [**rib-sample**](https://github.com/srid/rib-sample), from Github. - -## Concepts - -### Directory structure - -Let's look at what's in the template repository: - -```shell -$ git clone https://github.com/srid/rib-sample.git mysite -... -$ cd mysite -$ ls -F -content/ default.nix Main.hs README.md rib-sample.cabal +nix-shell --run ghcid ``` -The three key items here are: - -1. `Main.hs`: Haskell source containing the DSL of the HTML/CSS of your site. -1. `content/`: The source content (eg: Markdown sources and static files) -1. `dest/`: The target directory, excluded from the git repository, will contain - _generated_ content (i.e., the HTML files, and copied over static content) - -The template repository comes with a few sample posts under `content/`, and a basic -HTML layout and CSS style defined in `Main.hs`. - -### Run the site - -Now let's run them all. - -Clone the sample repository locally, install [Nix](https://nixos.org/nix/) (as -described in its README) and run your site as follows: +To test your changes, clone [rib-sample](https://github.com/srid/rib-sample) and run it using your local rib checkout: -```shell -nix-shell --run 'ghcid -T ":main serve"' ``` - -(Note that even though the author recommends it Nix is strictly not required; you may -simply run `ghcid -T ":main serve"` instead of the above command if you do not wish to -use Nix.) - -Running this command gives you a local HTTP server at http://127.0.0.1:8080 -(serving the generated files) that automatically reloads when either the content -(`content/`) or the HTML/CSS/build-actions (`Main.hs`) changes. Hot reload, in other -words. - -### How Rib works - -How does the aforementioned nix-shell command work? - -1. `nix-shell` will run the given command in a shell environment with all of our -dependencies (notably the Haskell ones including the `rib` library itself) -installed. - -1. [`ghcid`](https://github.com/ndmitchell/ghcid) will compile your `Main.hs` - and run its `main` function. - -1. `Main.hs:main` in turn calls `Rib.App.run` which takes as argument your custom - Shake action that will build the static site. - -1. `Rib.App.run`: this parses the CLI arguments and runs the rib CLI "app" which - can be run in one of a few modes --- generating static files, watching the - `content/` directory for changes, starting HTTP server for the `dest/` directory. - The "serve" subcommand will run the Shake build action passed as argument on - every file change and spin up a HTTP server. - -Run that command, and visit http://127.0.0.1:8080 to view your site. - -### Editing workflow - -Now try making some changes to the content, say `content/first-post.md`. You should -see it reflected when you refresh the page. Or change the HTML or CSS of your -site in `Main.hs`; this will trigger `ghcid` to rebuild the Haskell source and -restart the server. - -### What's next? - -Great, by now you should have your static site generator ready and running! - -Rib recommends writing your Shake actions in the style of being -[forward-defined](http://hackage.haskell.org/package/shake-0.18.3/docs/Development-Shake-Forward.html) -which adds to the simplicity of the entire thing. - -## Examples - -* [rib-sample](https://github.com/srid/rib-sample): Use this to get started with - your own site. - -* [zulip-archive](https://github.com/srid/zulip-archive): Zulip chat archive viewer ([running here](https://funprog.srid.ca/)). - -* [open-editions.org](https://github.com/open-editions/open-editions.org) ([running here](https://open-editions.org/)). - -* Rib powers the Zettelkasten system [neuron](https://github.com/srid/neuron#neuron) - * Example: [www.srid.ca](https://www.srid.ca/) - * Example: [neuron.srid.ca](https://neuron.srid.ca/) - * Example: [haskell.srid.ca](https://haskell.srid.ca/) +cd .. +git clone https://github.com/srid/rib-sample.git +cd rib-sample +nix-shell --arg rib ../rib --run 'ghcid -T ":main -wS"' +``` diff --git a/rib.cabal b/rib.cabal --- a/rib.cabal +++ b/rib.cabal @@ -1,6 +1,6 @@ -cabal-version: 2.2 +cabal-version: 2.4 name: rib -version: 0.8.0.0 +version: 0.10.0.0 license: BSD-3-Clause copyright: 2019 Sridhar Ratnakumar maintainer: srid@srid.ca @@ -8,9 +8,9 @@ homepage: https://github.com/srid/rib#readme bug-reports: https://github.com/srid/rib/issues synopsis: - Static site generator using Shake + Static site generator based on Shake description: - Haskell static site generator that aims to reuse existing libraries instead of reinventing the wheel + Haskell static site generator based on Shake, with a delightful development experience. category: Web build-type: Simple extra-source-files: @@ -21,21 +21,7 @@ type: git location: https://github.com/srid/rib -library - exposed-modules: - Rib - Rib.App - Rib.Watch - Rib.Parser.Dhall - Rib.Parser.MMark - Rib.Parser.Pandoc - Rib.Route - Rib.Shake - Rib.Settings - Rib.Extra.CSS - Rib.Extra.OpenGraph - other-modules: - Rib.Server +common library-common hs-source-dirs: src default-language: Haskell2010 default-extensions: NoImplicitPrelude @@ -67,8 +53,6 @@ pandoc >=2.7 && <3, pandoc-include-code >=1.5 && <1.6, pandoc-types >=1.20, - path >= 0.7.0, - path-io >= 1.6.0, relude >= 0.6 && < 0.7, safe-exceptions, shake >= 0.18.5, @@ -77,3 +61,33 @@ wai >=3.2.2 && <3.3, wai-app-static >=3.1.6 && <3.2, warp + +library + import: library-common + exposed-modules: + Rib + Rib.App + Rib.Cli + Rib.Watch + Rib.Log + Rib.Parser.Dhall + Rib.Parser.MMark + Rib.Parser.Pandoc + Rib.Route + Rib.Shake + Rib.Extra.CSS + Rib.Extra.OpenGraph + other-modules: + Rib.Server + +test-suite rib-test + import: library-common + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: + base-noprelude >=4.7 && <5, + relude, + hspec, + QuickCheck + diff --git a/src/Rib/App.hs b/src/Rib/App.hs --- a/src/Rib/App.hs +++ b/src/Rib/App.hs @@ -1,179 +1,127 @@ +{-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -- | CLI interface for Rib. -- -- Mostly you would only need `Rib.App.run`, passing it your Shake build action. module Rib.App - ( Command (..), - commandParser, - run, + ( run, runWith, ) where -import Control.Concurrent (threadDelay) import Control.Concurrent.Async (race_) import Control.Exception.Safe (catch) import Development.Shake hiding (command) import Development.Shake.Forward (shakeForward) import Options.Applicative -import Path -import Path.IO import Relude +import Rib.Cli (CliConfig (CliConfig), cliParser) +import qualified Rib.Cli as Cli +import Rib.Log import qualified Rib.Server as Server -import Rib.Settings (RibSettings (..)) import Rib.Watch (onTreeChange) -import System.FSNotify (Event (..), eventIsDirectory, eventPath) +import System.Directory +import System.FSNotify (Event (..), eventPath) +import System.FilePath import System.IO (BufferMode (LineBuffering), hSetBuffering) --- | Rib CLI commands -data Command - = -- Run an one-off generation with silent logging - -- TODO: Eventually replace this with proper logging mechanism. - OneOff - | -- | Generate the site once. - Generate - { -- | Force a full generation of /all/ files even if they were not modified - full :: Bool - } - | -- | Watch for changes in the input directory and run `Generate` - Watch - | -- | Run a HTTP server serving content from the output directory - Serve - { -- | Port to bind the server - port :: Int, - -- | Unless set run `WatchAndGenerate` automatically - dontWatch :: Bool - } - deriving (Show, Eq, Generic) - --- | Commandline parser `Parser` for the Rib CLI -commandParser :: Parser Command -commandParser = - hsubparser $ - mconcat - [ command "generate" $ info generateCommand $ progDesc "Run one-off generation of static files", - command "watch" $ info watchCommand $ progDesc "Watch the source directory, and generate when it changes", - command "serve" $ info serveCommand $ progDesc "Like watch, but also starts a HTTP server" - ] - where - generateCommand = - Generate <$> switch (long "full" <> help "Do a full generation (toggles shakeRebuild)") - watchCommand = - pure Watch - serveCommand = - Serve - <$> option auto (long "port" <> short 'p' <> help "HTTP server port" <> showDefault <> value 8080 <> metavar "PORT") - <*> switch (long "no-watch" <> help "Serve only; don't watch and regenerate") - -- | Run Rib using arguments passed in the command line. run :: - -- | Directory from which source content will be read. - Path Rel Dir -> - -- | The path where static files will be generated. Rib's server uses this - -- directory when serving files. - Path Rel Dir -> + -- | Default value for `Cli.inputDir` + FilePath -> + -- | Deault value for `Cli.outputDir` + FilePath -> -- | Shake build rules for building the static site Action () -> IO () -run src dst buildAction = runWith src dst buildAction =<< execParser opts +run src dst buildAction = runWith buildAction =<< execParser opts where opts = info - (commandParser <**> helper) + (cliParser src dst <**> helper) ( fullDesc - <> progDesc "Rib static site generator CLI" + <> progDesc "Generate a static site at OUTPUTDIR using input from INPUTDIR" ) --- | Like `run` but with an explicitly passed `Command` -runWith :: Path Rel Dir -> Path Rel Dir -> Action () -> Command -> IO () -runWith src dst buildAction ribCmd = do - when (src == currentRelDir) $ - -- Because otherwise our use of `watchTree` can interfere with Shake's file - -- scaning. - fail "cannot use '.' as source directory." +-- | Like `run` but with an explicitly passed `CliConfig` +runWith :: Action () -> CliConfig -> IO () +runWith buildAction cfg@CliConfig {..} = do -- For saner output flip hSetBuffering LineBuffering `mapM_` [stdout, stderr] - let ribSettings = - case ribCmd of - OneOff -> - RibSettings src dst Silent False - Generate fullGen -> - RibSettings src dst Verbose fullGen - _ -> - RibSettings src dst Verbose False - case ribCmd of - OneOff -> - runShake ribSettings buildAction - Generate _ -> - -- FIXME: Shouldn't `catch` Shake exceptions when invoked without fsnotify. - runShakeBuild ribSettings - Watch -> - runShakeAndObserve ribSettings - Serve p dw -> do - race_ (Server.serve p $ toFilePath dst) $ do - if dw - then threadDelay maxBound - else runShakeAndObserve ribSettings + case (watch, serve) of + (True, Just (host, port)) -> do + race_ + (Server.serve cfg host port $ outputDir) + (runShakeAndObserve cfg buildAction) + (True, Nothing) -> + runShakeAndObserve cfg buildAction + (False, Just (host, port)) -> + Server.serve cfg host port $ outputDir + (False, Nothing) -> + runShakeBuild cfg buildAction + +shakeOptionsFrom :: CliConfig -> ShakeOptions +shakeOptionsFrom cfg'@CliConfig {..} = + shakeOptions + { shakeVerbosity = verbosity, + shakeFiles = shakeDbDir, + shakeRebuild = bool [] [(RebuildNow, "**")] rebuildAll, + shakeLintInside = [""], + shakeExtra = addShakeExtra cfg' (shakeExtra shakeOptions) + } + +runShakeBuild :: CliConfig -> Action () -> IO () +runShakeBuild cfg@CliConfig {..} buildAction = do + runShake cfg $ do + logStrLn cfg $ "[Rib] Generating " <> inputDir <> " (rebuildAll=" <> show rebuildAll <> ")" + buildAction + +runShake :: CliConfig -> Action () -> IO () +runShake cfg shakeAction = do + shakeForward (shakeOptionsFrom cfg) shakeAction + `catch` handleShakeException where - currentRelDir = [reldir|.|] - -- Keep shake database directory under the src directory instead of the - -- (default) current working directory, which may not always be a project - -- root (as in the case of neuron). - shakeDatabaseDir :: Path Rel Dir = src [reldir|.shake|] - runShakeAndObserve ribSettings = do - -- Begin with a *full* generation as the HTML layout may have been changed. - -- TODO: This assumption is not true when running the program from compiled - -- binary (as opposed to say via ghcid) as the HTML layout has become fixed - -- by being part of the binary. In this scenario, we should not do full - -- generation (i.e., toggle the bool here to False). Perhaps provide a CLI - -- flag to disable this. - runShakeBuild $ ribSettings {_ribSettings_fullGen = True} - -- And then every time a file changes under the current directory - putStrLn $ "[Rib] Watching " <> toFilePath src <> " for changes" - onSrcChange $ runShakeBuild ribSettings - runShakeBuild ribSettings = do - runShake ribSettings $ do - putInfo $ "[Rib] Generating " <> toFilePath src <> " (full=" <> show (_ribSettings_fullGen ribSettings) <> ")" - buildAction - runShake ribSettings shakeAction = do - shakeForward (shakeOptionsFrom ribSettings) shakeAction - `catch` handleShakeException handleShakeException (e :: ShakeException) = -- Gracefully handle any exceptions when running Shake actions. We want -- Rib to keep running instead of crashing abruptly. - putStrLn $ + logErr $ "[Rib] Unhandled exception when building " <> shakeExceptionTarget e <> ": " <> show e - shakeOptionsFrom settings = - shakeOptions - { shakeVerbosity = _ribSettings_verbosity settings, - shakeFiles = toFilePath shakeDatabaseDir, - shakeRebuild = bool [] [(RebuildNow, "**")] (_ribSettings_fullGen settings), - shakeLintInside = [""], - shakeExtra = addShakeExtra settings (shakeExtra shakeOptions) - } + +runShakeAndObserve :: CliConfig -> Action () -> IO () +runShakeAndObserve cfg@CliConfig {..} buildAction = do + -- Begin with a *full* generation as the HTML layout may have been changed. + -- TODO: This assumption is not true when running the program from compiled + -- binary (as opposed to say via ghcid) as the HTML layout has become fixed + -- by being part of the binary. In this scenario, we should not do full + -- generation (i.e., toggle the bool here to False). Perhaps provide a CLI + -- flag to disable this. + runShakeBuild (cfg {Cli.rebuildAll = True}) buildAction + -- And then every time a file changes under the current directory + logStrLn cfg $ "[Rib] Watching " <> inputDir <> " for changes" + onSrcChange $ runShakeBuild cfg buildAction + where + onSrcChange :: IO () -> IO () onSrcChange f = do - workDir <- getCurrentDir + -- Canonicalizing path is important as we are comparing path ancestor using isPrefixOf + dir <- canonicalizePath inputDir -- Top-level directories to ignore from notifications - dirBlacklist <- traverse makeAbsolute [shakeDatabaseDir, src [reldir|.git|]] let isBlacklisted :: FilePath -> Bool - isBlacklisted p = or $ flip fmap dirBlacklist $ \b -> toFilePath b `isPrefixOf` p - onTreeChange src $ \allEvents -> do + isBlacklisted p = or $ flip fmap watchIgnore $ \b -> (dir b) `isPrefixOf` p + onTreeChange dir $ \allEvents -> do let events = filter (not . isBlacklisted . eventPath) allEvents unless (null events) $ do -- Log the changed events for diagnosis. - logEvent workDir `mapM_` events + logEvent `mapM_` events f - logEvent workDir e = do - eventRelPath <- - if eventIsDirectory e - then fmap toFilePath . makeRelative workDir =<< parseAbsDir (eventPath e) - else fmap toFilePath . makeRelative workDir =<< parseAbsFile (eventPath e) - putStrLn $ eventLogPrefix e <> " " <> eventRelPath + logEvent :: Event -> IO () + logEvent e = do + logStrLn cfg $ eventLogPrefix e <> " " <> eventPath e eventLogPrefix = \case -- Single character log prefix to indicate file actions is a convention in Rib. Added _ _ _ -> "A" diff --git a/src/Rib/Cli.hs b/src/Rib/Cli.hs new file mode 100644 --- /dev/null +++ b/src/Rib/Cli.hs @@ -0,0 +1,166 @@ +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Rib.Cli + ( CliConfig (..), + cliParser, + Verbosity (..), + + -- * Parser helpers + directoryReader, + watchOption, + serveOption, + + -- * Internal + hostPortParser, + ) +where + +import Development.Shake (Verbosity (..)) +import Options.Applicative +import Relude +import Relude.Extra.Tuple +import System.FilePath +import qualified Text.Megaparsec as M +import qualified Text.Megaparsec.Char as M + +-- Rib's CLI configuration +-- +-- Can be retrieved using `Rib.Shake.getCliConfig` in the `Development.Shake.Action` monad. +data CliConfig + = CliConfig + { -- | Whether to rebuild all sources in Shake. + rebuildAll :: Bool, + -- | Whether to monitor `inputDir` for changes and re-generate + watch :: Bool, + -- | Whether to run a HTTP server on `outputDir` + serve :: Maybe (Text, Int), + -- | Shake's verbosity level. + -- + -- Setting this to `Silent` will affect Rib's own logging as well. + verbosity :: Verbosity, + -- | Directory from which source content will be read. + inputDir :: FilePath, + -- | The path where static files will be generated. Rib's server uses this + -- directory when serving files. + outputDir :: FilePath, + -- | Path to shake's database directory. + shakeDbDir :: FilePath, + -- | List of relative paths to ignore when watching the source directory + watchIgnore :: [FilePath] + } + deriving (Show, Eq, Generic, Typeable) + +cliParser :: FilePath -> FilePath -> Parser CliConfig +cliParser inputDirDefault outputDirDefault = do + rebuildAll <- + switch + ( long "rebuild-all" + <> help "Rebuild all sources" + ) + watch <- watchOption + serve <- serveOption + verbosity <- + fmap + (bool Verbose Silent) + ( switch + ( long "quiet" + <> help "Log nothing" + ) + ) + ~(inputDir, shakeDbDir) <- + fmap (mapToSnd shakeDbDirFrom) $ + option + directoryReader + ( long "input-dir" + <> metavar "INPUTDIR" + <> value inputDirDefault + <> help ("Directory containing the source files (" <> "default: " <> inputDirDefault <> ")") + ) + outputDir <- + option + directoryReader + ( long "output-dir" + <> metavar "OUTPUTDIR" + <> value outputDirDefault + <> help ("Directory where files will be generated (" <> "default: " <> outputDirDefault <> ")") + ) + ~(watchIgnore) <- pure builtinWatchIgnores + pure CliConfig {..} + +watchOption :: Parser Bool +watchOption = + switch + ( long "watch" + <> short 'w' + <> help "Watch for changes and regenerate" + ) + +serveOption :: Parser (Maybe (Text, Int)) +serveOption = + optional + ( option + (megaparsecReader hostPortParser) + ( long "serve" + <> short 's' + <> metavar "[HOST]:PORT" + <> help "Run a HTTP server on the generated directory" + ) + ) + <|> ( fmap (bool Nothing $ Just (defaultHost, 8080)) $ + switch (short 'S' <> help ("Like `-s " <> toString defaultHost <> ":8080`")) + ) + +builtinWatchIgnores :: [FilePath] +builtinWatchIgnores = + [ ".shake", + ".git" + ] + +shakeDbDirFrom :: FilePath -> FilePath +shakeDbDirFrom inputDir = + -- Keep shake database directory under the src directory instead of the + -- (default) current working directory, which may not always be a project + -- root (as in the case of neuron). + inputDir ".shake" + +-- | Like `str` but adds a trailing slash if there isn't one. +directoryReader :: ReadM FilePath +directoryReader = fmap addTrailingPathSeparator str + +megaparsecReader :: M.Parsec Void Text a -> ReadM a +megaparsecReader p = + eitherReader (first M.errorBundlePretty . M.parse p "" . toText) + +hostPortParser :: M.Parsec Void Text (Text, Int) +hostPortParser = do + host <- + optional $ + M.string "localhost" + <|> M.try parseIP + void $ M.char ':' + port <- parseNumRange 1 65535 + pure (fromMaybe defaultHost host, port) + where + readNum = maybe (fail "Not a number") pure . readMaybe + parseIP :: M.Parsec Void Text Text + parseIP = do + a <- parseNumRange 0 255 <* M.char '.' + b <- parseNumRange 0 255 <* M.char '.' + c <- parseNumRange 0 255 <* M.char '.' + d <- parseNumRange 0 255 + pure $ toText $ intercalate "." $ show <$> [a, b, c, d] + parseNumRange :: Int -> Int -> M.Parsec Void Text Int + parseNumRange a b = do + n <- readNum =<< M.some M.digitChar + if a <= n && n <= b + then pure n + else fail $ "Number not in range: " <> show a <> "-" <> show b + +defaultHost :: Text +defaultHost = "127.0.0.1" diff --git a/src/Rib/Log.hs b/src/Rib/Log.hs new file mode 100644 --- /dev/null +++ b/src/Rib/Log.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} + +module Rib.Log + ( logStrLn, + logErr, + ) +where + +import Development.Shake (Verbosity (..)) +import Relude +import Rib.Cli (CliConfig (..)) +import System.IO (hPutStrLn) + +logStrLn :: MonadIO m => CliConfig -> String -> m () +logStrLn CliConfig {..} s = + unless (verbosity == Silent) $ do + putStrLn s + +logErr :: MonadIO m => String -> m () +logErr s = + liftIO $ hPutStrLn stderr s diff --git a/src/Rib/Parser/Dhall.hs b/src/Rib/Parser/Dhall.hs --- a/src/Rib/Parser/Dhall.hs +++ b/src/Rib/Parser/Dhall.hs @@ -15,22 +15,22 @@ import Development.Shake import Dhall (FromDhall, auto, input) -import Path import Relude import Rib.Shake (ribInputDir) import System.Directory +import System.FilePath -- | Parse a Dhall file as Haskell type. parse :: FromDhall a => -- | Dependent .dhall files, which must trigger a rebuild - [Path Rel File] -> + [FilePath] -> -- | The Dhall file to parse. Relative to `ribInputDir`. - Path Rel File -> + FilePath -> Action a -parse (map toFilePath -> deps) f = do +parse deps f = do inputDir <- ribInputDir need deps - s <- toText <$> readFile' (toFilePath $ inputDir f) - liftIO $ withCurrentDirectory (toFilePath inputDir) $ + s <- toText <$> readFile' (inputDir f) + liftIO $ withCurrentDirectory inputDir $ input auto s diff --git a/src/Rib/Parser/MMark.hs b/src/Rib/Parser/MMark.hs --- a/src/Rib/Parser/MMark.hs +++ b/src/Rib/Parser/MMark.hs @@ -34,9 +34,9 @@ import Control.Foldl (Fold (..)) import Development.Shake (Action, readFile') import Lucid.Base (HtmlT (..)) -import Path import Relude import Rib.Shake (ribInputDir) +import System.FilePath import Text.MMark (MMark, projectYaml) import qualified Text.MMark as MMark import qualified Text.MMark.Extension as Ext @@ -73,16 +73,16 @@ parsePure = parsePureWith defaultExts -- | Parse Markdown using mmark -parse :: Path Rel File -> Action MMark +parse :: FilePath -> Action MMark parse = parseWith defaultExts -- | Like `parse` but takes a custom list of MMark extensions -parseWith :: [MMark.Extension] -> Path Rel File -> Action MMark +parseWith :: [MMark.Extension] -> FilePath -> Action MMark parseWith exts f = either (fail . toString) pure =<< do inputDir <- ribInputDir - s <- toText <$> readFile' (toFilePath $ inputDir f) - pure $ parsePureWith exts (toFilePath f) s + s <- toText <$> readFile' (inputDir f) + pure $ parsePureWith exts f s -- | Get the first image in the document if one exists getFirstImg :: MMark -> Maybe URI diff --git a/src/Rib/Parser/Pandoc.hs b/src/Rib/Parser/Pandoc.hs --- a/src/Rib/Parser/Pandoc.hs +++ b/src/Rib/Parser/Pandoc.hs @@ -32,9 +32,9 @@ import Data.Aeson import Development.Shake (Action, readFile') import Lucid (HtmlT, toHtmlRaw) -import Path import Relude import Rib.Shake (ribInputDir) +import System.FilePath import Text.Pandoc import Text.Pandoc.Filter.IncludeCode (includeCode) import qualified Text.Pandoc.Readers @@ -54,12 +54,12 @@ parse :: -- | The pandoc text reader function to use, eg: `readMarkdown` (ReaderOptions -> Text -> PandocIO Pandoc) -> - Path Rel File -> + FilePath -> Action Pandoc parse textReader f = either fail pure =<< do inputDir <- ribInputDir - content <- toText <$> readFile' (toFilePath $ inputDir f) + content <- toText <$> readFile' (inputDir f) fmap (first show) $ runExceptT $ do v' <- runIO' $ textReader readerSettings content liftIO $ walkM includeSources v' diff --git a/src/Rib/Route.hs b/src/Rib/Route.hs --- a/src/Rib/Route.hs +++ b/src/Rib/Route.hs @@ -23,9 +23,9 @@ import Data.Kind import qualified Data.Text as T import Development.Shake (Action) -import Path import Relude import Rib.Shake (writeFileCached) +import System.FilePath -- | A route is a GADT which represents the individual routes in a static site. -- @@ -33,16 +33,16 @@ class IsRoute (r :: Type -> Type) where -- | Return the filepath (relative to `Rib.Shake.ribInputDir`) where the -- generated content for this route should be written. - routeFile :: MonadThrow m => r a -> m (Path Rel File) + routeFile :: MonadThrow m => r a -> m (FilePath) data UrlType = Relative | Absolute -path2Url :: Path Rel File -> UrlType -> Text -path2Url fp = toText . toFilePath . \case +path2Url :: FilePath -> UrlType -> Text +path2Url fp = toText . \case Relative -> fp Absolute -> - [absdir|/|] fp + "/" fp -- | The absolute URL to this route (relative to site root) routeUrl :: IsRoute r => r a -> Text diff --git a/src/Rib/Server.hs b/src/Rib/Server.hs --- a/src/Rib/Server.hs +++ b/src/Rib/Server.hs @@ -10,23 +10,27 @@ import Network.Wai.Application.Static (defaultFileServerSettings, staticApp) import qualified Network.Wai.Handler.Warp as Warp import Relude +import Rib.Cli (CliConfig) +import Rib.Log -- | Run a HTTP server to serve a directory of static files -- -- Binds the server to host 127.0.0.1. serve :: + CliConfig -> + -- | Host + Text -> -- | Port number to bind to Int -> -- | Directory to serve. FilePath -> IO () -serve port path = do - putStrLn $ "[Rib] Serving " <> path <> " at http://" <> host <> ":" <> show port +serve cfg host port path = do + logStrLn cfg $ "[Rib] Serving " <> path <> " at http://" <> toString host <> ":" <> show port Warp.runSettings settings app where app = staticApp $ defaultFileServerSettings path - host = "127.0.0.1" settings = - Warp.setHost (fromString host) + Warp.setHost (fromString $ toString host) $ Warp.setPort port $ Warp.defaultSettings diff --git a/src/Rib/Settings.hs b/src/Rib/Settings.hs deleted file mode 100644 --- a/src/Rib/Settings.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE ViewPatterns #-} - -module Rib.Settings - ( RibSettings (..), - ) -where - -import Development.Shake (Verbosity) -import Path -import Relude - --- | The settings with which Rib is run --- --- RibSettings is initialized with the values passed to `Rib.App.run` -data RibSettings - = RibSettings - { _ribSettings_inputDir :: Path Rel Dir, - _ribSettings_outputDir :: Path Rel Dir, - -- | Shake verbosity level - _ribSettings_verbosity :: Verbosity, - -- | Whether we must try to generate all files even if they have not - -- been modified since last generation. - _ribSettings_fullGen :: Bool - } - deriving (Typeable) diff --git a/src/Rib/Shake.hs b/src/Rib/Shake.hs --- a/src/Rib/Shake.hs +++ b/src/Rib/Shake.hs @@ -16,68 +16,68 @@ writeFileCached, -- * Misc + getCliConfig, ribInputDir, ribOutputDir, - getDirectoryFiles', ) where +import Control.Monad.Catch import Development.Shake -import Path -import Path.IO import Relude -import Rib.Settings +import Rib.Cli (CliConfig) +import qualified Rib.Cli as Cli +import System.Directory +import System.FilePath +import System.IO.Error (isDoesNotExistError) -- | Get rib settings from a shake Action monad. -ribSettings :: Action RibSettings -ribSettings = getShakeExtra >>= \case +getCliConfig :: Action CliConfig +getCliConfig = getShakeExtra >>= \case Just v -> pure v - Nothing -> fail "RibSettings not initialized" + Nothing -> fail "CliConfig not initialized" -- | Input directory containing source files -- -- This is same as the first argument to `Rib.App.run` -ribInputDir :: Action (Path Rel Dir) -ribInputDir = _ribSettings_inputDir <$> ribSettings +ribInputDir :: Action FilePath +ribInputDir = Cli.inputDir <$> getCliConfig -- | Output directory where files are generated -- -- This is same as the second argument to `Rib.App.run` -ribOutputDir :: Action (Path Rel Dir) +ribOutputDir :: Action FilePath ribOutputDir = do - output <- _ribSettings_outputDir <$> ribSettings - liftIO $ createDirIfMissing True output + output <- Cli.outputDir <$> getCliConfig + liftIO $ createDirectoryIfMissing True output return output -- | Shake action to copy static files as is. -buildStaticFiles :: [Path Rel File] -> Action () +buildStaticFiles :: [FilePath] -> Action () buildStaticFiles staticFilePatterns = do input <- ribInputDir output <- ribOutputDir - files <- getDirectoryFiles' input staticFilePatterns + files <- getDirectoryFiles input staticFilePatterns void $ forP files $ \f -> - copyFileChanged' (input f) (output f) - where - copyFileChanged' (toFilePath -> old) (toFilePath -> new) = - copyFileChanged old new + copyFileChanged (input f) (output f) -- | Run the given action when any file matching the patterns changes forEvery :: -- | Source file patterns (relative to `ribInputDir`) - [Path Rel File] -> - (Path Rel File -> Action a) -> + [FilePath] -> + (FilePath -> Action a) -> Action [a] forEvery pats f = do input <- ribInputDir - fs <- getDirectoryFiles' input pats + fs <- getDirectoryFiles input pats forP fs f -- | Write the given file but only when it has been modified. -- -- Also, always writes under ribOutputDir -writeFileCached :: Path Rel File -> String -> Action () +writeFileCached :: FilePath -> String -> Action () writeFileCached !k !s = do - f <- fmap (toFilePath . ( k)) ribOutputDir + f <- fmap ( k) ribOutputDir currentS <- liftIO $ forgivingAbsence $ readFile f unless (Just s == currentS) $ do writeFile' f $! s @@ -85,7 +85,12 @@ -- logging modified files being read. putInfo $ "+ " <> f --- | Like `getDirectoryFiles` but works with `Path` -getDirectoryFiles' :: Typeable b => Path b Dir -> [Path Rel File] -> Action [Path Rel File] -getDirectoryFiles' (toFilePath -> dir) (fmap toFilePath -> pat) = - traverse (liftIO . parseRelFile) =<< getDirectoryFiles dir pat +-- | If argument of the function throws a +-- 'System.IO.Error.doesNotExistErrorType', 'Nothing' is returned (other +-- exceptions propagate). Otherwise the result is returned inside a 'Just'. +forgivingAbsence :: (MonadIO m, MonadCatch m) => m a -> m (Maybe a) +forgivingAbsence f = + catchIf + isDoesNotExistError + (Just <$> f) + (const $ return Nothing) diff --git a/src/Rib/Watch.hs b/src/Rib/Watch.hs --- a/src/Rib/Watch.hs +++ b/src/Rib/Watch.hs @@ -13,7 +13,6 @@ import Control.Concurrent (threadDelay) import Control.Concurrent.Async (race) import Control.Concurrent.Chan -import Path import Relude import System.FSNotify (Event (..), watchTreeChan, withManager) @@ -22,11 +21,11 @@ -- -- If multiple events fire rapidly, the IO action is invoked only once, taking -- those multiple events as its argument. -onTreeChange :: Path b t -> ([Event] -> IO ()) -> IO () +onTreeChange :: FilePath -> ([Event] -> IO ()) -> IO () onTreeChange fp f = do withManager $ \mgr -> do eventCh <- newChan - void $ watchTreeChan mgr (toFilePath fp) (const True) eventCh + void $ watchTreeChan mgr fp (const True) eventCh forever $ do firstEvent <- readChan eventCh events <- debounce 100 [firstEvent] $ readChan eventCh diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}