content: {-# 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
    ( run,
      runWith,
    )
  where
  
  import Control.Concurrent.Async (race_)
  import Control.Exception.Safe (catch)
  import Development.Shake hiding (command)
  import Development.Shake.Forward (shakeForward)
  import Options.Applicative
  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.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`
    FilePath ->
    -- | Deault value for `Cli.outputDir`
    FilePath ->
    -- | Shake build rules for building the static site
    Action () ->
    IO ()
  run src dst buildAction = runWith buildAction =<< execParser opts
    where
      opts =
        info
          (cliParser src dst <**> helper)
          ( fullDesc
              <> progDesc "Generate a static site at OUTPUTDIR using input from INPUTDIR"
          )
  
  -- | 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]
    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
      handleShakeException (e :: ShakeException) =
        -- Gracefully handle any exceptions when running Shake actions. We want
        -- Rib to keep running instead of crashing abruptly.
        logErr $
          "[Rib] Unhandled exception when building " <> shakeExceptionTarget e <> ": " <> show e
  
  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
        -- Canonicalizing path is important as we are comparing path ancestor using isPrefixOf
        dir <- canonicalizePath inputDir
        -- Top-level directories to ignore from notifications
        let isBlacklisted :: FilePath -> Bool
            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 `mapM_` events
            f
      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"
        Modified _ _ _ -> "M"
        Removed _ _ _ -> "D"
        Unknown _ _ _ -> "?"
  