Merge pull request #152 from srid/absolute-path

Path revamp

CHANGELOG.md

@@ -2,11 +2,16 @@
 
 ## 0.9.0.0 (UNRELEASED, DEV)
 
+- 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

rib.cabal

@@ -53,8 +53,6 @@ common library-common
         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,

src/Rib/App.hs

@@ -20,23 +20,23 @@ 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.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)
 
 -- | Run Rib using arguments passed in the command line.
 run ::
   -- | Default value for `Cli.inputDir`
-  Path Rel Dir ->
+  FilePath ->
   -- | Deault value for `Cli.outputDir`
-  Path Rel Dir ->
+  FilePath ->
   -- | Shake build rules for building the static site
   Action () ->
   IO ()
@@ -52,31 +52,25 @@ run src dst buildAction = runWith buildAction =<< execParser opts
 -- | Like `run` but with an explicitly passed `CliConfig`
 runWith :: Action () -> CliConfig -> IO ()
 runWith buildAction cfg@CliConfig {..} = do
-  when (inputDir == currentRelDir) $
-    -- Because otherwise our use of `watchTree` can interfere with Shake's file
-    -- scaning.
-    fail "cannot use '.' as source directory."
   -- For saner output
   flip hSetBuffering LineBuffering `mapM_` [stdout, stderr]
   case (watch, serve) of
     (True, Just (host, port)) -> do
       race_
-        (Server.serve cfg host port $ toFilePath outputDir)
+        (Server.serve cfg host port $ outputDir)
         (runShakeAndObserve cfg buildAction)
     (True, Nothing) ->
       runShakeAndObserve cfg buildAction
     (False, Just (host, port)) ->
-      Server.serve cfg host port $ toFilePath outputDir
+      Server.serve cfg host port $ outputDir
     (False, Nothing) ->
       runShakeBuild cfg buildAction
-  where
-    currentRelDir = [reldir|.|]
 
 shakeOptionsFrom :: CliConfig -> ShakeOptions
 shakeOptionsFrom cfg'@CliConfig {..} =
   shakeOptions
     { shakeVerbosity = verbosity,
-      shakeFiles = toFilePath shakeDbDir,
+      shakeFiles = shakeDbDir,
       shakeRebuild = bool [] [(RebuildNow, "**")] rebuildAll,
       shakeLintInside = [""],
       shakeExtra = addShakeExtra cfg' (shakeExtra shakeOptions)
@@ -85,7 +79,7 @@ shakeOptionsFrom cfg'@CliConfig {..} =
 runShakeBuild :: CliConfig -> Action () -> IO ()
 runShakeBuild cfg@CliConfig {..} buildAction = do
   runShake cfg $ do
-    logStrLn cfg $ "[Rib] Generating " <> toFilePath inputDir <> " (rebuildAll=" <> show rebuildAll <> ")"
+    logStrLn cfg $ "[Rib] Generating " <> inputDir <> " (rebuildAll=" <> show rebuildAll <> ")"
     buildAction
 
 runShake :: CliConfig -> Action () -> IO ()
@@ -109,27 +103,25 @@ runShakeAndObserve cfg@CliConfig {..} buildAction = do
   -- 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 " <> toFilePath inputDir <> " for changes"
+  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 [shakeDbDir, inputDir </> [reldir|.git|]]
       let isBlacklisted :: FilePath -> Bool
-          isBlacklisted p = or $ flip fmap dirBlacklist $ \b -> toFilePath b `isPrefixOf` p
-      onTreeChange inputDir $ \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)
-      logStrLn cfg $ 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"

src/Rib/Cli.hs

@@ -4,10 +4,17 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Rib.Cli
   ( CliConfig (..),
     cliParser,
+    Verbosity (..),
+
+    -- * Parser helpers
+    directoryReader,
+    watchOption,
+    serveOption,
 
     -- * Internal
     hostPortParser,
@@ -16,9 +23,9 @@ where
 
 import Development.Shake (Verbosity (..))
 import Options.Applicative
-import Path
 import Relude
 import Relude.Extra.Tuple
+import System.FilePath
 import qualified Text.Megaparsec as M
 import qualified Text.Megaparsec.Char as M
 
@@ -38,38 +45,26 @@ data CliConfig
         -- Setting this to `Silent` will affect Rib's own logging as well.
         verbosity :: Verbosity,
         -- | Directory from which source content will be read.
-        inputDir :: Path Rel Dir,
+        inputDir :: FilePath,
         -- | The path where static files will be generated.  Rib's server uses this
         -- directory when serving files.
-        outputDir :: Path Rel Dir,
+        outputDir :: FilePath,
         -- | Path to shake's database directory.
-        shakeDbDir :: Path Rel Dir
+        shakeDbDir :: FilePath,
+        -- | List of relative paths to ignore when watching the source directory
+        watchIgnore :: [FilePath]
       }
   deriving (Show, Eq, Generic, Typeable)
 
-cliParser :: Path Rel Dir -> Path Rel Dir -> Parser CliConfig
+cliParser :: FilePath -> FilePath -> Parser CliConfig
 cliParser inputDirDefault outputDirDefault = do
   rebuildAll <-
     switch
       ( long "rebuild-all"
           <> help "Rebuild all sources"
       )
-  watch <-
-    switch
-      ( long "watch"
-          <> short 'w'
-          <> help "Watch for changes and regenerate"
-      )
-  serve <-
-    optional
-      ( option
-          (megaparsecReader hostPortParser)
-          ( long "serve"
-              <> short 's'
-              <> metavar "[HOST]:PORT"
-              <> help "Run a HTTP server on the generated directory"
-          )
-      )
+  watch <- watchOption
+  serve <- serveOption
   verbosity <-
     fmap
       (bool Verbose Silent)
@@ -80,29 +75,63 @@ cliParser inputDirDefault outputDirDefault = do
       )
   ~(inputDir, shakeDbDir) <-
     fmap (mapToSnd shakeDbDirFrom) $
-      relDirOption
+      option
+        directoryReader
         ( long "input-dir"
             <> metavar "INPUTDIR"
-            <> value (toFilePath inputDirDefault)
-            <> help ("Directory containing the source files (" <> "default: " <> toFilePath inputDirDefault <> ")")
+            <> value inputDirDefault
+            <> help ("Directory containing the source files (" <> "default: " <> inputDirDefault <> ")")
         )
   outputDir <-
-    relDirOption
+    option
+      directoryReader
       ( long "output-dir"
           <> metavar "OUTPUTDIR"
-          <> value (toFilePath outputDirDefault)
-          <> help ("Directory where files will be generated (" <> "default: " <> toFilePath outputDirDefault <> ")")
+          <> value outputDirDefault
+          <> help ("Directory where files will be generated (" <> "default: " <> outputDirDefault <> ")")
       )
+  ~(watchIgnore) <- pure builtinWatchIgnores
   pure CliConfig {..}
-  where
-    relDirOption = fmap (either (error . toText . displayException) id . parseRelDir) . strOption
 
-shakeDbDirFrom :: Path Rel Dir -> Path Rel Dir
+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 </> [reldir|.shake|]
+  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 =
@@ -116,7 +145,7 @@ hostPortParser = do
         <|> M.try parseIP
   void $ M.char ':'
   port <- parseNumRange 1 65535
-  pure (fromMaybe "127.0.0.1" host, port)
+  pure (fromMaybe defaultHost host, port)
   where
     readNum = maybe (fail "Not a number") pure . readMaybe
     parseIP :: M.Parsec Void Text Text
@@ -132,3 +161,6 @@ hostPortParser = do
       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"

src/Rib/Parser/Dhall.hs

@@ -15,22 +15,22 @@ where
 
 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

src/Rib/Parser/MMark.hs

@@ -34,9 +34,9 @@ where
 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 ::
 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

src/Rib/Parser/Pandoc.hs

@@ -32,9 +32,9 @@ import Control.Monad.Except (MonadError, liftEither, runExcept)
 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 @@ parsePure textReader s =
 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'

src/Rib/Route.hs

@@ -23,9 +23,9 @@ import Control.Monad.Catch
 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 @@ import Rib.Shake (writeFileCached)
 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

src/Rib/Shake.hs

@@ -19,16 +19,17 @@ module Rib.Shake
     getCliConfig,
     ribInputDir,
     ribOutputDir,
-    getDirectoryFiles',
   )
 where
 
+import Control.Monad.Catch
 import Development.Shake
-import Path
-import Path.IO
 import Relude
 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.
 getCliConfig :: Action CliConfig
@@ -39,47 +40,44 @@ getCliConfig = getShakeExtra >>= \case
 -- | Input directory containing source files
 --
 -- This is same as the first argument to `Rib.App.run`
-ribInputDir :: Action (Path Rel Dir)
+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 <- Cli.outputDir <$> getCliConfig
-  liftIO $ createDirIfMissing True output
+  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
@@ -87,7 +85,12 @@ writeFileCached !k !s = do
     -- 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)

src/Rib/Watch.hs

@@ -13,7 +13,6 @@ where
 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 @@ import System.FSNotify (Event (..), watchTreeChan, withManager)
 --
 -- 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

test/Rib/CliSpec.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
 module Rib.CliSpec