{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings   #-}

{-|
Module      : Stack.FileWatch
License     : BSD-3-Clause
-}

module Stack.FileWatch
  ( WatchMode (WatchModePoll)
  , fileWatch
  , fileWatchPoll
  ) where

import           Control.Concurrent.STM ( check )
import qualified Data.Map.Merge.Strict as Map
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import           GHC.IO.Exception
                   ( IOErrorType (InvalidArgument), IOException (..) )
import           Path ( fileExtension, parent )
import           Path.IO ( doesFileExist, executable, getPermissions )
import           RIO.Process
                   ( EnvVars, HasProcessContext (..), proc, runProcess
                   , withModifyEnvVars
                   )
import           System.Permissions ( osIsWindows )
import           Stack.Prelude
import           Stack.Types.Config ( Config (..), HasConfig (..) )
import           Stack.Types.Runner ( HasRunner (..), Runner (..) )
import           System.FSNotify
                   ( WatchConfig, WatchMode (..), confWatchMode, defaultConfig
                   , eventPath, watchDir, withManagerConf
                   )
import           System.IO ( getLine )

fileWatch ::
     (HasConfig env, HasTerm env)
  => ((Set (Path Abs File) -> IO ()) -> RIO Runner ())
  -> RIO env ()
fileWatch :: forall env.
(HasConfig env, HasTerm env) =>
((Set (Path Abs File) -> IO ()) -> RIO Runner ()) -> RIO env ()
fileWatch = WatchConfig
-> ((Set (Path Abs File) -> IO ()) -> RIO Runner ()) -> RIO env ()
forall env.
(HasConfig env, HasTerm env) =>
WatchConfig
-> ((Set (Path Abs File) -> IO ()) -> RIO Runner ()) -> RIO env ()
fileWatchConf WatchConfig
defaultConfig

fileWatchPoll ::
     (HasConfig env, HasTerm env)
  => ((Set (Path Abs File) -> IO ()) -> RIO Runner ())
  -> RIO env ()
fileWatchPoll :: forall env.
(HasConfig env, HasTerm env) =>
((Set (Path Abs File) -> IO ()) -> RIO Runner ()) -> RIO env ()
fileWatchPoll =
  WatchConfig
-> ((Set (Path Abs File) -> IO ()) -> RIO Runner ()) -> RIO env ()
forall env.
(HasConfig env, HasTerm env) =>
WatchConfig
-> ((Set (Path Abs File) -> IO ()) -> RIO Runner ()) -> RIO env ()
fileWatchConf (WatchConfig
 -> ((Set (Path Abs File) -> IO ()) -> RIO Runner ()) -> RIO env ())
-> WatchConfig
-> ((Set (Path Abs File) -> IO ()) -> RIO Runner ())
-> RIO env ()
forall a b. (a -> b) -> a -> b
$ WatchConfig
defaultConfig { confWatchMode = WatchModePoll 1000000 }

-- | Run an action, watching for file changes

--

-- The action provided takes a callback that is used to set the files to be

-- watched. When any of those files are changed, we rerun the action again.

fileWatchConf ::
     (HasConfig env, HasTerm env)
  => WatchConfig
  -> ((Set (Path Abs File) -> IO ()) -> RIO Runner ())
  -> RIO env ()
fileWatchConf :: forall env.
(HasConfig env, HasTerm env) =>
WatchConfig
-> ((Set (Path Abs File) -> IO ()) -> RIO Runner ()) -> RIO env ()
fileWatchConf WatchConfig
cfg (Set (Path Abs File) -> IO ()) -> RIO Runner ()
inner = do
  runner <- Getting Runner env Runner -> RIO env Runner
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Runner env Runner
forall env. HasRunner env => Lens' env Runner
Lens' env Runner
runnerL
  mHook <- view $ configL . to (.fileWatchHook)
  withRunInIO $ \forall a. RIO env a -> IO a
run -> WatchConfig -> (WatchManager -> IO ()) -> IO ()
forall a. WatchConfig -> (WatchManager -> IO a) -> IO a
withManagerConf WatchConfig
cfg ((WatchManager -> IO ()) -> IO ())
-> (WatchManager -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WatchManager
manager -> do
    allFiles <- Set FilePath -> IO (TVar (Set FilePath))
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Set FilePath
forall a. Set a
Set.empty
    dirtyVar <- newTVarIO True
    watchVar <- newTVarIO Map.empty

    let onChange Event
event = STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          files <- TVar (Set FilePath) -> STM (Set FilePath)
forall a. TVar a -> STM a
readTVar TVar (Set FilePath)
allFiles
          when (eventPath event `Set.member` files) (writeTVar dirtyVar True)

        setWatched :: Set (Path Abs File) -> IO ()
        setWatched Set (Path Abs File)
files = do
          STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (Set FilePath) -> Set FilePath -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Set FilePath)
allFiles (Set FilePath -> STM ()) -> Set FilePath -> STM ()
forall a b. (a -> b) -> a -> b
$ (Path Abs File -> FilePath) -> Set (Path Abs File) -> Set FilePath
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Set (Path Abs File)
files
          watch0 <- TVar (Map (Path Abs Dir) (IO ()))
-> IO (Map (Path Abs Dir) (IO ()))
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Map (Path Abs Dir) (IO ()))
watchVar
          let actions = SimpleWhenMissing (Path Abs Dir) (IO ()) (IO (Maybe (IO ())))
-> SimpleWhenMissing (Path Abs Dir) () (IO (Maybe (IO ())))
-> SimpleWhenMatched (Path Abs Dir) (IO ()) () (IO (Maybe (IO ())))
-> Map (Path Abs Dir) (IO ())
-> Map (Path Abs Dir) ()
-> Map (Path Abs Dir) (IO (Maybe (IO ())))
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
Map.merge
                ((Path Abs Dir -> IO () -> IO (Maybe (IO ())))
-> SimpleWhenMissing (Path Abs Dir) (IO ()) (IO (Maybe (IO ())))
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing Path Abs Dir -> IO () -> IO (Maybe (IO ()))
forall {m :: * -> *} {p} {a}.
MonadUnliftIO m =>
p -> m () -> m (Maybe a)
stopListening)
                ((Path Abs Dir -> () -> IO (Maybe (IO ())))
-> SimpleWhenMissing (Path Abs Dir) () (IO (Maybe (IO ())))
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing Path Abs Dir -> () -> IO (Maybe (IO ()))
startListening)
                ((Path Abs Dir -> IO () -> () -> IO (Maybe (IO ())))
-> SimpleWhenMatched (Path Abs Dir) (IO ()) () (IO (Maybe (IO ())))
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
Map.zipWithMatched Path Abs Dir -> IO () -> () -> IO (Maybe (IO ()))
forall {f :: * -> *} {p} {a}.
Applicative f =>
p -> a -> () -> f (Maybe a)
keepListening)
                Map (Path Abs Dir) (IO ())
watch0
                Map (Path Abs Dir) ()
newDirs
          watch1 <- forM (Map.toList actions) $ \(Path Abs Dir
k, IO (Maybe (IO ()))
mmv) ->
            IO (Maybe (IO ()))
mmv IO (Maybe (IO ()))
-> (Maybe (IO ()) -> Map (Path Abs Dir) (IO ()))
-> IO (Map (Path Abs Dir) (IO ()))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
              Maybe (IO ())
Nothing -> Map (Path Abs Dir) (IO ())
forall k a. Map k a
Map.empty
              Just IO ()
v -> Path Abs Dir -> IO () -> Map (Path Abs Dir) (IO ())
forall k a. k -> a -> Map k a
Map.singleton Path Abs Dir
k IO ()
v
          atomically $ writeTVar watchVar $ Map.unions watch1
         where
          newDirs :: Map (Path Abs Dir) ()
newDirs = [(Path Abs Dir, ())] -> Map (Path Abs Dir) ()
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Path Abs Dir, ())] -> Map (Path Abs Dir) ())
-> [(Path Abs Dir, ())] -> Map (Path Abs Dir) ()
forall a b. (a -> b) -> a -> b
$ (Path Abs Dir -> (Path Abs Dir, ()))
-> [Path Abs Dir] -> [(Path Abs Dir, ())]
forall a b. (a -> b) -> [a] -> [b]
map (, ())
                  ([Path Abs Dir] -> [(Path Abs Dir, ())])
-> [Path Abs Dir] -> [(Path Abs Dir, ())]
forall a b. (a -> b) -> a -> b
$ Set (Path Abs Dir) -> [Path Abs Dir]
forall a. Set a -> [a]
Set.toList
                  (Set (Path Abs Dir) -> [Path Abs Dir])
-> Set (Path Abs Dir) -> [Path Abs Dir]
forall a b. (a -> b) -> a -> b
$ (Path Abs File -> Path Abs Dir)
-> Set (Path Abs File) -> Set (Path Abs Dir)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Set (Path Abs File)
files

          keepListening :: p -> a -> () -> f (Maybe a)
keepListening p
_dir a
listen () = Maybe a -> f (Maybe a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> f (Maybe a)) -> Maybe a -> f (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
listen
          stopListening :: p -> m () -> m (Maybe a)
stopListening p
_ m ()
f = do
            () <- m ()
f m () -> (IOException -> m ()) -> m ()
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \IOException
ioe ->
              -- Ignore invalid argument error - it can happen if

              -- the directory is removed.

              case IOException -> IOErrorType
ioe_type IOException
ioe of
                IOErrorType
InvalidArgument -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                IOErrorType
_ -> IOException -> m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO IOException
ioe
            pure Nothing
          startListening :: Path Abs Dir -> () -> IO (Maybe (IO ()))
startListening Path Abs Dir
dir () = do
            let dir' :: FilePath
dir' = FilePath -> FilePath
forall a. IsString a => FilePath -> a
fromString (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs Dir
dir
            listen <- WatchManager
-> FilePath -> ActionPredicate -> (Event -> IO ()) -> IO (IO ())
watchDir WatchManager
manager FilePath
dir' (Bool -> ActionPredicate
forall a b. a -> b -> a
const Bool
True) Event -> IO ()
onChange
            pure $ Just listen

    let watchInput = do
          l <- IO FilePath
getLine
          unless (l == "quit") $ do
            run $ case l of
              FilePath
"help" -> do
                StyleDoc -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
StyleDoc -> m ()
prettyInfo (StyleDoc -> RIO env ()) -> StyleDoc -> RIO env ()
forall a b. (a -> b) -> a -> b
$
                     StyleDoc
line
                  StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
                       [ Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"help" StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
                       , FilePath -> StyleDoc
flow FilePath
"display this help."
                       ]
                  StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
                  StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
                       [ Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"quit" StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
                       , StyleDoc
"exit."
                       ]
                  StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
                  StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
                       [ Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"build" StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
                       , FilePath -> StyleDoc
flow FilePath
"force a rebuild."
                       ]
                  StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
                  StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
                       [ Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"watched" StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
                       , FilePath -> StyleDoc
flow FilePath
"display watched files."
                       ]
              FilePath
"build" -> STM () -> RIO env ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> RIO env ()) -> STM () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ TVar Bool -> Bool -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Bool
dirtyVar Bool
True
              FilePath
"watched" -> do
                watch <- TVar (Set FilePath) -> RIO env (Set FilePath)
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Set FilePath)
allFiles
                mapM_ (prettyInfo . style File . fromString) (Set.toList watch)
              FilePath
"" -> STM () -> RIO env ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> RIO env ()) -> STM () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ TVar Bool -> Bool -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Bool
dirtyVar Bool
True
              FilePath
_ -> [StyleDoc] -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyInfoL
                     [ FilePath -> StyleDoc
flow FilePath
"Unknown command:"
                     , Style -> StyleDoc -> StyleDoc
style Style
Shell (FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString FilePath
l) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
                     , StyleDoc
"Try"
                     , Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"help" StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
                     ]

            watchInput

    race_ watchInput $ run $ forever $ do
      atomically $ do
        dirty <- readTVar dirtyVar
        check dirty

      eres <- tryAny $ runRIO runner (inner setWatched)

      -- Clear dirtiness flag after the build to avoid an infinite loop caused

      -- by the build itself triggering dirtiness. This could be viewed as a

      -- bug, since files changed during the build will not trigger an extra

      -- rebuild, but overall seems like better behavior. See

      -- https://github.com/commercialhaskell/stack/issues/822

      atomically $ writeTVar dirtyVar False

      let defaultAction = case Either SomeException ()
eres of
            Left SomeException
e ->
              case SomeException -> Maybe ExitCode
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
                Just ExitCode
ExitSuccess ->
                  StyleDoc -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
StyleDoc -> m ()
prettyInfo (StyleDoc -> RIO env ()) -> StyleDoc -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Style -> StyleDoc -> StyleDoc
style Style
Good (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString (FilePath -> StyleDoc) -> FilePath -> StyleDoc
forall a b. (a -> b) -> a -> b
$ SomeException -> FilePath
forall e. Exception e => e -> FilePath
displayException SomeException
e
                Maybe ExitCode
_ -> case SomeException -> Maybe PrettyException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e :: Maybe PrettyException of
                  Just PrettyException
pe -> StyleDoc -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
StyleDoc -> m ()
prettyError (StyleDoc -> RIO env ()) -> StyleDoc -> RIO env ()
forall a b. (a -> b) -> a -> b
$ PrettyException -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty PrettyException
pe
                  Maybe PrettyException
_ -> StyleDoc -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
StyleDoc -> m ()
prettyInfo (StyleDoc -> RIO env ()) -> StyleDoc -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Style -> StyleDoc -> StyleDoc
style Style
Error (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString (FilePath -> StyleDoc) -> FilePath -> StyleDoc
forall a b. (a -> b) -> a -> b
$ SomeException -> FilePath
forall e. Exception e => e -> FilePath
displayException SomeException
e
            Either SomeException ()
_ -> StyleDoc -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
StyleDoc -> m ()
prettyInfo (StyleDoc -> RIO env ()) -> StyleDoc -> RIO env ()
forall a b. (a -> b) -> a -> b
$
                   Style -> StyleDoc -> StyleDoc
style Style
Good (FilePath -> StyleDoc
flow FilePath
"Success! Waiting for next file change.")

      case mHook of
        Maybe (Path Abs File)
Nothing -> RIO env ()
defaultAction
        Just Path Abs File
hook -> do
          hookIsExecutable <- (IOException -> RIO env Bool) -> RIO env Bool -> RIO env Bool
forall (m :: * -> *) a.
MonadUnliftIO m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> Bool -> RIO env Bool
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) (RIO env Bool -> RIO env Bool) -> RIO env Bool -> RIO env Bool
forall a b. (a -> b) -> a -> b
$ if Bool
osIsWindows
            then
              -- can't really detect executable on windows, only file extension

              Path Abs File -> RIO env Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
hook
            else Permissions -> Bool
executable (Permissions -> Bool) -> RIO env Permissions -> RIO env Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Abs File -> RIO env Permissions
forall (m :: * -> *) b t. MonadIO m => Path b t -> m Permissions
getPermissions Path Abs File
hook
          if hookIsExecutable
            then runFileWatchHook eres hook
            else do
              prettyWarn $
                flow "File watch hook not executable. Falling back on default."
              defaultAction

      prettyInfoL
        [ "Type"
        , style Shell "help"
        , flow "for the available commands. Press enter to force a rebuild."
        ]

runFileWatchHook ::
     (HasProcessContext env, HasTerm env)
  => Either SomeException ()
  -> Path Abs File
  -> RIO env ()
runFileWatchHook :: forall env.
(HasProcessContext env, HasTerm env) =>
Either SomeException () -> Path Abs File -> RIO env ()
runFileWatchHook Either SomeException ()
buildResult Path Abs File
hook =
  (EnvVars -> EnvVars) -> RIO env () -> RIO env ()
forall env (m :: * -> *) a.
(HasProcessContext env, MonadReader env m, MonadIO m) =>
(EnvVars -> EnvVars) -> m a -> m a
withModifyEnvVars EnvVars -> EnvVars
insertBuildResultInEnv (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ do
    let (FilePath
cmd, [FilePath]
args) = if Bool
osIsWindows Bool -> Bool -> Bool
&& Bool
isShFile
          then (FilePath
"sh", [Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs File
hook])
          else (Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs File
hook, [])
    menv <- Getting ProcessContext env ProcessContext -> RIO env ProcessContext
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProcessContext env ProcessContext
forall env. HasProcessContext env => Lens' env ProcessContext
Lens' env ProcessContext
processContextL
    withProcessContext menv $ proc cmd args runProcess >>= \case
      ExitCode
ExitSuccess -> () -> RIO env ()
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      ExitFailure Int
i -> do
        [StyleDoc] -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
          [ FilePath -> StyleDoc
flow FilePath
"File watch hook exited with code:"
          , Style -> StyleDoc -> StyleDoc
style Style
Error (FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString (FilePath -> StyleDoc) -> FilePath -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
i) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
          ]
        () -> RIO env ()
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
 where
  insertBuildResultInEnv :: EnvVars -> EnvVars
  insertBuildResultInEnv :: EnvVars -> EnvVars
insertBuildResultInEnv = Text -> Text -> EnvVars -> EnvVars
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"HOOK_FW_RESULT" (Text -> EnvVars -> EnvVars) -> Text -> EnvVars -> EnvVars
forall a b. (a -> b) -> a -> b
$ case Either SomeException ()
buildResult of
    Left SomeException
e -> FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ SomeException -> FilePath
forall e. Exception e => e -> FilePath
displayException SomeException
e
    Right ()
_ -> Text
""
  isShFile :: Bool
isShFile = case Path Abs File -> Maybe FilePath
forall (m :: * -> *) b. MonadThrow m => Path b File -> m FilePath
fileExtension Path Abs File
hook of
    Just FilePath
".sh" -> Bool
True
    Maybe FilePath
_ -> Bool
False