mirror of
https://github.com/srid/rib.git
synced 2024-09-11 13:37:20 +03:00
Switch back to FilePath
This commit is contained in:
parent
1ae6a35d69
commit
a778ff4973
@ -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,
|
||||
|
@ -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 Abs Dir ->
|
||||
FilePath ->
|
||||
-- | Deault value for `Cli.outputDir`
|
||||
Path Abs 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,26 +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
|
||||
workDir <- getCurrentDirectory
|
||||
-- Top-level directories to ignore from notifications
|
||||
dirBlacklist <- traverse makeAbsolute [shakeDbDir, inputDir </> [reldir|.git|]]
|
||||
dirBlacklist <- traverse makeAbsolute [shakeDbDir, inputDir </> ".git"]
|
||||
let isBlacklisted :: FilePath -> Bool
|
||||
isBlacklisted p = or $ flip fmap dirBlacklist $ \b -> toFilePath b `isPrefixOf` p
|
||||
isBlacklisted p = or $ flip fmap dirBlacklist $ \b -> b `isPrefixOf` p
|
||||
onTreeChange inputDir $ \allEvents -> do
|
||||
let events = filter (not . isBlacklisted . eventPath) allEvents
|
||||
unless (null events) $ do
|
||||
-- Log the changed events for diagnosis.
|
||||
logEvent workDir `mapM_` events
|
||||
f
|
||||
logEvent :: FilePath -> Event -> IO ()
|
||||
logEvent workDir e = do
|
||||
eventRelPath <-
|
||||
if eventIsDirectory e
|
||||
then fmap toFilePath . makeRelative workDir =<< parseAbsDir (eventPath e)
|
||||
else fmap toFilePath . makeRelative workDir =<< parseAbsFile (eventPath e)
|
||||
let eventRelPath = makeRelative workDir $ eventPath e
|
||||
logStrLn cfg $ eventLogPrefix e <> " " <> eventRelPath
|
||||
eventLogPrefix = \case
|
||||
-- Single character log prefix to indicate file actions is a convention in Rib.
|
||||
|
@ -17,9 +17,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
|
||||
|
||||
@ -39,16 +39,16 @@ 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 Abs Dir,
|
||||
inputDir :: FilePath,
|
||||
-- | The path where static files will be generated. Rib's server uses this
|
||||
-- directory when serving files.
|
||||
outputDir :: Path Abs Dir,
|
||||
outputDir :: FilePath,
|
||||
-- | Path to shake's database directory.
|
||||
shakeDbDir :: Path Abs Dir
|
||||
shakeDbDir :: FilePath
|
||||
}
|
||||
deriving (Show, Eq, Generic, Typeable)
|
||||
|
||||
cliParser :: Path Abs Dir -> Path Abs Dir -> Parser CliConfig
|
||||
cliParser :: FilePath -> FilePath -> Parser CliConfig
|
||||
cliParser inputDirDefault outputDirDefault = do
|
||||
rebuildAll <-
|
||||
switch
|
||||
@ -81,31 +81,27 @@ cliParser inputDirDefault outputDirDefault = do
|
||||
)
|
||||
~(inputDir, shakeDbDir) <-
|
||||
fmap (mapToSnd shakeDbDirFrom) $
|
||||
option
|
||||
absDirReader
|
||||
strOption
|
||||
( long "input-dir"
|
||||
<> metavar "INPUTDIR"
|
||||
<> value inputDirDefault
|
||||
<> help ("Directory containing the source files (" <> "default: " <> toFilePath inputDirDefault <> ")")
|
||||
<> help ("Directory containing the source files (" <> "default: " <> inputDirDefault <> ")")
|
||||
)
|
||||
outputDir <-
|
||||
option
|
||||
absDirReader
|
||||
strOption
|
||||
( long "output-dir"
|
||||
<> metavar "OUTPUTDIR"
|
||||
<> value outputDirDefault
|
||||
<> help ("Directory where files will be generated (" <> "default: " <> toFilePath outputDirDefault <> ")")
|
||||
<> help ("Directory where files will be generated (" <> "default: " <> outputDirDefault <> ")")
|
||||
)
|
||||
pure CliConfig {..}
|
||||
where
|
||||
absDirReader = eitherReader $ first (toString . displayException) . parseAbsDir
|
||||
|
||||
shakeDbDirFrom :: Path Abs Dir -> Path Abs Dir
|
||||
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"
|
||||
|
||||
megaparsecReader :: M.Parsec Void Text a -> ReadM a
|
||||
megaparsecReader p =
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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'
|
||||
|
@ -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
|
||||
|
@ -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 Abs 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 Abs 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)
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user