{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# 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,
    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 qualified Rib.Server as Server
import Rib.Settings (RibSettings (..))
import Rib.Watch (onTreeChange)
import System.FSNotify (Event (..), eventIsDirectory, eventPath)
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
        Command -> Bool
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
        Command -> Int
port :: Int,
        -- | Unless set run `WatchAndGenerate` automatically
        Command -> Bool
dontWatch :: Bool
      }
  deriving (Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
(Int -> Command -> ShowS)
-> (Command -> String) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> String
$cshow :: Command -> String
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show, Command -> Command -> Bool
(Command -> Command -> Bool)
-> (Command -> Command -> Bool) -> Eq Command
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Command -> Command -> Bool
$c/= :: Command -> Command -> Bool
== :: Command -> Command -> Bool
$c== :: Command -> Command -> Bool
Eq, (forall x. Command -> Rep Command x)
-> (forall x. Rep Command x -> Command) -> Generic Command
forall x. Rep Command x -> Command
forall x. Command -> Rep Command x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Command x -> Command
$cfrom :: forall x. Command -> Rep Command x
Generic)

-- | Commandline parser `Parser` for the Rib CLI
commandParser :: Parser Command
commandParser :: Parser Command
commandParser =
  Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
hsubparser (Mod CommandFields Command -> Parser Command)
-> Mod CommandFields Command -> Parser Command
forall a b. (a -> b) -> a -> b
$
    [Mod CommandFields Command] -> Mod CommandFields Command
forall a. Monoid a => [a] -> a
mconcat
      [ String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
command "generate" (ParserInfo Command -> Mod CommandFields Command)
-> ParserInfo Command -> Mod CommandFields Command
forall a b. (a -> b) -> a -> b
$ Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
generateCommand (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ String -> InfoMod Command
forall a. String -> InfoMod a
progDesc "Run one-off generation of static files",
        String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
command "watch" (ParserInfo Command -> Mod CommandFields Command)
-> ParserInfo Command -> Mod CommandFields Command
forall a b. (a -> b) -> a -> b
$ Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
watchCommand (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ String -> InfoMod Command
forall a. String -> InfoMod a
progDesc "Watch the source directory, and generate when it changes",
        String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
command "serve" (ParserInfo Command -> Mod CommandFields Command)
-> ParserInfo Command -> Mod CommandFields Command
forall a b. (a -> b) -> a -> b
$ Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
serveCommand (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ String -> InfoMod Command
forall a. String -> InfoMod a
progDesc "Like watch, but also starts a HTTP server"
      ]
  where
    generateCommand :: Parser Command
generateCommand =
      Bool -> Command
Generate (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "full" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help "Do a full generation (toggles shakeRebuild)")
    watchCommand :: Parser Command
watchCommand =
      Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
Watch
    serveCommand :: Parser Command
serveCommand =
      Int -> Bool -> Command
Serve
        (Int -> Bool -> Command) -> Parser Int -> Parser (Bool -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "port" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'p' Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help "HTTP server port" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Int
forall a (f :: * -> *). Show a => Mod f a
showDefault Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value 8080 Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar "PORT")
        Parser (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "no-watch" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
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 ->
  -- | Shake build rules for building the static site
  Action () ->
  IO ()
run :: Path Rel Dir -> Path Rel Dir -> Action () -> IO ()
run src :: Path Rel Dir
src dst :: Path Rel Dir
dst buildAction :: Action ()
buildAction = Path Rel Dir -> Path Rel Dir -> Action () -> Command -> IO ()
runWith Path Rel Dir
src Path Rel Dir
dst Action ()
buildAction (Command -> IO ()) -> IO Command -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ParserInfo Command -> IO Command
forall a. ParserInfo a -> IO a
execParser ParserInfo Command
opts
  where
    opts :: ParserInfo Command
opts =
      Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info
        (Parser Command
commandParser Parser Command -> Parser (Command -> Command) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Command -> Command)
forall a. Parser (a -> a)
helper)
        ( InfoMod Command
forall a. InfoMod a
fullDesc
            InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod Command
forall a. String -> InfoMod a
progDesc "Rib static site generator CLI"
        )

-- | Like `run` but with an explicitly passed `Command`
runWith :: Path Rel Dir -> Path Rel Dir -> Action () -> Command -> IO ()
runWith :: Path Rel Dir -> Path Rel Dir -> Action () -> Command -> IO ()
runWith src :: Path Rel Dir
src dst :: Path Rel Dir
dst buildAction :: Action ()
buildAction ribCmd :: Command
ribCmd = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Path Rel Dir
src Path Rel Dir -> Path Rel Dir -> Bool
forall a. Eq a => a -> a -> Bool
== Path Rel Dir
forall b t. Path b t
currentRelDir) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    -- Because otherwise our use of `watchTree` can interfere with Shake's file
    -- scaning.
    String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "cannot use '.' as source directory."
  -- For saner output
  (Handle -> BufferMode -> IO ()) -> BufferMode -> Handle -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Handle -> BufferMode -> IO ()
hSetBuffering BufferMode
LineBuffering (Handle -> IO ()) -> [Handle] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
`mapM_` [Handle
stdout, Handle
stderr]
  let ribSettings :: RibSettings
ribSettings =
        case Command
ribCmd of
          OneOff ->
            Path Rel Dir -> Path Rel Dir -> Verbosity -> Bool -> RibSettings
RibSettings Path Rel Dir
src Path Rel Dir
dst Verbosity
Silent Bool
False
          Generate fullGen :: Bool
fullGen ->
            Path Rel Dir -> Path Rel Dir -> Verbosity -> Bool -> RibSettings
RibSettings Path Rel Dir
src Path Rel Dir
dst Verbosity
Verbose Bool
fullGen
          _ ->
            Path Rel Dir -> Path Rel Dir -> Verbosity -> Bool -> RibSettings
RibSettings Path Rel Dir
src Path Rel Dir
dst Verbosity
Verbose Bool
False
  case Command
ribCmd of
    OneOff ->
      RibSettings -> Action () -> IO ()
runShake RibSettings
ribSettings Action ()
buildAction
    Generate _ ->
      -- FIXME: Shouldn't `catch` Shake exceptions when invoked without fsnotify.
      RibSettings -> IO ()
runShakeBuild RibSettings
ribSettings
    Watch ->
      RibSettings -> IO ()
runShakeAndObserve RibSettings
ribSettings
    Serve p :: Int
p dw :: Bool
dw -> do
      IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO ()
race_ (Int -> String -> IO ()
Server.serve Int
p (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Rel Dir -> String
forall b t. Path b t -> String
toFilePath Path Rel Dir
dst) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        if Bool
dw
          then Int -> IO ()
threadDelay Int
forall a. Bounded a => a
maxBound
          else RibSettings -> IO ()
runShakeAndObserve RibSettings
ribSettings
  where
    currentRelDir :: Path b t
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).
    Path Rel Dir
shakeDatabaseDir :: Path Rel Dir = Path Rel Dir
src Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> [reldir|.shake|]
    runShakeAndObserve :: RibSettings -> IO ()
runShakeAndObserve ribSettings :: RibSettings
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.
      RibSettings -> IO ()
runShakeBuild (RibSettings -> IO ()) -> RibSettings -> IO ()
forall a b. (a -> b) -> a -> b
$ RibSettings
ribSettings {_ribSettings_fullGen :: Bool
_ribSettings_fullGen = Bool
True}
      -- And then every time a file changes under the current directory
      String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "[Rib] Watching " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Path Rel Dir -> String
forall b t. Path b t -> String
toFilePath Path Rel Dir
src String -> ShowS
forall a. Semigroup a => a -> a -> a
<> " for changes"
      IO () -> IO ()
onSrcChange (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ RibSettings -> IO ()
runShakeBuild RibSettings
ribSettings
    runShakeBuild :: RibSettings -> IO ()
runShakeBuild ribSettings :: RibSettings
ribSettings = do
      RibSettings -> Action () -> IO ()
runShake RibSettings
ribSettings (Action () -> IO ()) -> Action () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        String -> Action ()
putInfo (String -> Action ()) -> String -> Action ()
forall a b. (a -> b) -> a -> b
$ "[Rib] Generating " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Path Rel Dir -> String
forall b t. Path b t -> String
toFilePath Path Rel Dir
src String -> ShowS
forall a. Semigroup a => a -> a -> a
<> " (full=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Bool -> String
forall b a. (Show a, IsString b) => a -> b
show (RibSettings -> Bool
_ribSettings_fullGen RibSettings
ribSettings) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ")"
        Action ()
buildAction
    runShake :: RibSettings -> Action () -> IO ()
runShake ribSettings :: RibSettings
ribSettings shakeAction :: Action ()
shakeAction = do
      ShakeOptions -> Action () -> IO ()
shakeForward (RibSettings -> ShakeOptions
shakeOptionsFrom RibSettings
ribSettings) Action ()
shakeAction
        IO () -> (ShakeException -> IO ()) -> IO ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` ShakeException -> IO ()
forall (m :: * -> *). MonadIO m => ShakeException -> m ()
handleShakeException
    handleShakeException :: ShakeException -> m ()
handleShakeException (ShakeException
e :: ShakeException) =
      -- Gracefully handle any exceptions when running Shake actions. We want
      -- Rib to keep running instead of crashing abruptly.
      String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$
        "[Rib] Unhandled exception when building " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShakeException -> String
shakeExceptionTarget ShakeException
e String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShakeException -> String
forall b a. (Show a, IsString b) => a -> b
show ShakeException
e
    shakeOptionsFrom :: RibSettings -> ShakeOptions
shakeOptionsFrom settings :: RibSettings
settings =
      ShakeOptions
shakeOptions
        { shakeVerbosity :: Verbosity
shakeVerbosity = RibSettings -> Verbosity
_ribSettings_verbosity RibSettings
settings,
          shakeFiles :: String
shakeFiles = Path Rel Dir -> String
forall b t. Path b t -> String
toFilePath Path Rel Dir
shakeDatabaseDir,
          shakeRebuild :: [(Rebuild, String)]
shakeRebuild = [(Rebuild, String)]
-> [(Rebuild, String)] -> Bool -> [(Rebuild, String)]
forall a. a -> a -> Bool -> a
bool [] [(Rebuild
RebuildNow, "**")] (RibSettings -> Bool
_ribSettings_fullGen RibSettings
settings),
          shakeLintInside :: [String]
shakeLintInside = [""],
          shakeExtra :: HashMap TypeRep Dynamic
shakeExtra = RibSettings -> HashMap TypeRep Dynamic -> HashMap TypeRep Dynamic
forall a.
Typeable a =>
a -> HashMap TypeRep Dynamic -> HashMap TypeRep Dynamic
addShakeExtra RibSettings
settings (ShakeOptions -> HashMap TypeRep Dynamic
shakeExtra ShakeOptions
shakeOptions)
        }
    onSrcChange :: IO () -> IO ()
onSrcChange f :: IO ()
f = do
      Path Abs Dir
workDir <- IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getCurrentDir
      -- Top-level directories to ignore from notifications
      [Path Abs Dir]
dirBlacklist <- (Path Rel Dir -> IO (Path Abs Dir))
-> [Path Rel Dir] -> IO [Path Abs Dir]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Path Rel Dir -> IO (Path Abs Dir)
forall path (m :: * -> *).
(AnyPath path, MonadIO m) =>
path -> m (AbsPath path)
makeAbsolute [Path Rel Dir
shakeDatabaseDir, Path Rel Dir
src Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> [reldir|.git|]]
      let isBlacklisted :: FilePath -> Bool
          isBlacklisted :: String -> Bool
isBlacklisted p :: String
p = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ ((Path Abs Dir -> Bool) -> [Path Abs Dir] -> [Bool])
-> [Path Abs Dir] -> (Path Abs Dir -> Bool) -> [Bool]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Path Abs Dir -> Bool) -> [Path Abs Dir] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Path Abs Dir]
dirBlacklist ((Path Abs Dir -> Bool) -> [Bool])
-> (Path Abs Dir -> Bool) -> [Bool]
forall a b. (a -> b) -> a -> b
$ \b :: Path Abs Dir
b -> Path Abs Dir -> String
forall b t. Path b t -> String
toFilePath Path Abs Dir
b String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
p
      Path Rel Dir -> ([Event] -> IO ()) -> IO ()
forall b t. Path b t -> ([Event] -> IO ()) -> IO ()
onTreeChange Path Rel Dir
src (([Event] -> IO ()) -> IO ()) -> ([Event] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \allEvents :: [Event]
allEvents -> do
        let events :: [Event]
events = (Event -> Bool) -> [Event] -> [Event]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Event -> Bool) -> Event -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isBlacklisted (String -> Bool) -> (Event -> String) -> Event -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> String
eventPath) [Event]
allEvents
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Event] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Event]
events) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          -- Log the changed events for diagnosis.
          Path Abs Dir -> Event -> IO ()
forall (m :: * -> *).
(MonadThrow m, MonadIO m) =>
Path Abs Dir -> Event -> m ()
logEvent Path Abs Dir
workDir (Event -> IO ()) -> [Event] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
`mapM_` [Event]
events
          IO ()
f
    logEvent :: Path Abs Dir -> Event -> m ()
logEvent workDir :: Path Abs Dir
workDir e :: Event
e = do
      String
eventRelPath <-
        if Event -> Bool
eventIsDirectory Event
e
          then (Path Rel Dir -> String) -> m (Path Rel Dir) -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Path Rel Dir -> String
forall b t. Path b t -> String
toFilePath (m (Path Rel Dir) -> m String)
-> (Path Abs Dir -> m (Path Rel Dir)) -> Path Abs Dir -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> Path Abs Dir -> m (RelPath (Path Abs Dir))
forall path (m :: * -> *).
(AnyPath path, MonadThrow m) =>
Path Abs Dir -> path -> m (RelPath path)
makeRelative Path Abs Dir
workDir (Path Abs Dir -> m String) -> m (Path Abs Dir) -> m String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> m (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Abs Dir)
parseAbsDir (Event -> String
eventPath Event
e)
          else (Path Rel File -> String) -> m (Path Rel File) -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Path Rel File -> String
forall b t. Path b t -> String
toFilePath (m (Path Rel File) -> m String)
-> (Path Abs File -> m (Path Rel File))
-> Path Abs File
-> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> Path Abs File -> m (RelPath (Path Abs File))
forall path (m :: * -> *).
(AnyPath path, MonadThrow m) =>
Path Abs Dir -> path -> m (RelPath path)
makeRelative Path Abs Dir
workDir (Path Abs File -> m String) -> m (Path Abs File) -> m String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> m (Path Abs File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Abs File)
parseAbsFile (Event -> String
eventPath Event
e)
      String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ Event -> String
eventLogPrefix Event
e String -> ShowS
forall a. Semigroup a => a -> a -> a
<> " " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
eventRelPath
    eventLogPrefix :: Event -> String
eventLogPrefix = \case
      -- Single character log prefix to indicate file actions is a convention in Rib.
      Added _ _ _ -> "A"
      Modified _ _ _ -> "M"
      Removed _ _ _ -> "D"
      Unknown _ _ _ -> "?"