content: {-# LANGUAGE AllowAmbiguousTypes #-}
  {-# LANGUAGE BangPatterns #-}
  {-# LANGUAGE DeriveAnyClass #-}
  
  module Ema.Generate (
    generateSiteFromModel,
    generateSiteFromModel',
  ) where
  
  import Control.Exception (throwIO)
  import Control.Monad.Except (MonadError (throwError))
  import Control.Monad.Logger (
    LogLevel (LevelError, LevelInfo),
    MonadLogger,
    MonadLoggerIO,
    logWithoutLoc,
   )
  import Ema.Asset (Asset (..))
  import Ema.CLI (crash)
  import Ema.Route.Class (IsRoute (RouteModel, routePrism, routeUniverse))
  import Ema.Route.Prism (
    checkRoutePrismGivenRoute,
    fromPrism_,
   )
  import Ema.Site (EmaSite (siteOutput), EmaStaticSite)
  import Optics.Core (review)
  import System.Directory (copyFile, createDirectoryIfMissing, doesDirectoryExist, doesFileExist, doesPathExist)
  import System.FilePath (takeDirectory, (</>))
  import System.FilePattern.Directory (getDirectoryFiles)
  
  log :: (MonadLogger m) => LogLevel -> Text -> m ()
  log = logWithoutLoc "ema.generate"
  
  {- | Generate the static site at `dest`
  
    The *only* data we need is the `RouteModel`.
  -}
  generateSiteFromModel ::
    forall r m.
    (MonadIO m, MonadLoggerIO m, MonadFail m, Eq r, Show r, IsRoute r, EmaStaticSite r) =>
    -- | Target directory to write files to. Must exist.
    FilePath ->
    -- | The model data used to generate assets.
    RouteModel r ->
    m [FilePath]
  generateSiteFromModel dest model =
    withBlockBuffering $ do
      runExceptT (generateSiteFromModel' @r dest model) >>= \case
        Left err -> do
          crash "ema" err
        Right fs ->
          pure fs
    where
      -- Temporarily use block buffering before calling an IO action that is
      -- known ahead to log rapidly, so as to not hamper serial processing speed.
      withBlockBuffering f =
        hSetBuffering stdout (BlockBuffering Nothing)
          *> f
          <* (hSetBuffering stdout LineBuffering >> hFlush stdout)
  
  -- | Like `generateSiteFromModel` but without buffering or error handling.
  generateSiteFromModel' ::
    forall r m.
    (MonadIO m, MonadLoggerIO m, MonadError Text m, Eq r, Show r, EmaStaticSite r) =>
    FilePath ->
    RouteModel r ->
    -- | List of generated files.
    m [FilePath]
  generateSiteFromModel' dest model = do
    let enc = routePrism @r
        rp = fromPrism_ $ enc model
    -- Sanity checks
    unlessM (liftIO $ doesDirectoryExist dest) $ do
      throwError $ "Destination directory does not exist: " <> toText dest
    let routes = routeUniverse @r model
    when (null routes) $
      throwError "Your app's `routeUniverse` is empty; nothing to generate!"
    forM_ routes $ \route ->
      checkRoutePrismGivenRoute enc model route
        `whenLeft_` throwError
    -- For Github Pages
    noBirdbrainedJekyll dest
    -- Enumerate and write all routes.
    log LevelInfo $ "Writing " <> show (length routes) <> " routes"
    fmap concat . forM routes $ \r -> do
      let fp = dest </> review rp r
      siteOutput rp model r >>= \case
        AssetStatic staticPath -> do
          liftIO (doesPathExist staticPath) >>= \case
            True ->
              -- NOTE: A static path can indeed be a directory. The user is not
              -- obliged to recursively list the files.
              copyRecursively staticPath fp
            False ->
              log LevelError $ toText $ "? " <> staticPath <> " (missing)"
          pure []
        AssetGenerated _fmt !s -> do
          writeFileGenerated fp s
          pure [fp]
  
  {- | Disable birdbrained hacks from GitHub to disable surprises like,
   https://github.com/jekyll/jekyll/issues/55
  -}
  noBirdbrainedJekyll :: (MonadIO m, MonadLoggerIO m) => FilePath -> m ()
  noBirdbrainedJekyll dest = do
    let nojekyll = dest </> ".nojekyll"
    liftIO (doesFileExist nojekyll) >>= \case
      True -> pass
      False -> do
        log LevelInfo $ "Disabling Jekyll by writing " <> toText nojekyll
        writeFileLBS nojekyll ""
  
  newtype StaticAssetMissing = StaticAssetMissing FilePath
    deriving stock (Show)
    deriving anyclass (Exception)
  
  writeFileGenerated :: (MonadLogger m, MonadIO m) => FilePath -> LByteString -> m ()
  writeFileGenerated fp s = do
    log LevelInfo $ toText $ "W " <> fp
    liftIO $ do
      createDirectoryIfMissing True (takeDirectory fp)
      writeFileLBS fp s
  
  {- | Copy a file or directory recursively to the target directory
  
    Like `cp -R src dest`.
  -}
  copyRecursively ::
    forall m.
    ( MonadIO m
    , MonadLoggerIO m
    ) =>
    -- | Absolute path to source file or directory to copy.
    FilePath ->
    -- | Target file or directory path.
    FilePath ->
    m ()
  copyRecursively src dest = do
    fs <- enumerateFilesToCopy src dest
    forM_ fs $ \(a, b) -> do
      log LevelInfo $ toText $ "C " <> b
      copyFileCreatingParents a b
    where
      enumerateFilesToCopy :: FilePath -> FilePath -> m [(FilePath, FilePath)]
      enumerateFilesToCopy a b = do
        liftIO (doesFileExist a) >>= \case
          True ->
            pure [(a, b)]
          False -> do
            liftIO (doesDirectoryExist a) >>= \case
              False ->
                liftIO $ throwIO $ StaticAssetMissing a
              True -> do
                fs <- liftIO $ getDirectoryFiles src ["**"]
                pure $ fs <&> \fp -> (a </> fp, b </> fp)
  
      copyFileCreatingParents a b =
        liftIO $ do
          createDirectoryIfMissing True (takeDirectory b)
          copyFile a b
  