content: {-# LANGUAGE DeriveAnyClass #-}
  {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
  
  {-# HLINT ignore "Use impureThrow" #-}
  
  module Ema.Route.Lib.Extra.StaticRoute (
    StaticRoute,
    Model (..),
  
    -- * Helpers
    staticRouteUrl,
  ) where
  
  import Control.Exception (throw)
  import Control.Monad.Logger (MonadLogger, MonadLoggerIO)
  import Data.List qualified as List
  import Data.Map.Strict qualified as Map
  import Data.Time (UTCTime, defaultTimeLocale, formatTime, getCurrentTime)
  import Ema
  import Ema.CLI qualified
  import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
  import Optics.Core (Prism', prism')
  import System.FilePath (takeExtension, (</>))
  import System.UnionMount qualified as UnionMount
  import UnliftIO (MonadUnliftIO)
  
  -- | Route to a static file under @baseDir@.
  newtype StaticRoute (baseDir :: Symbol) = StaticRoute {unStaticRoute :: FilePath}
    deriving newtype (Eq, Ord, Show)
    deriving stock (Generic)
  
  data Model = Model
    { modelCliAction :: Ema.CLI.Action
    , modelFiles :: Map FilePath UTCTime
    }
    deriving stock (Eq, Show, Generic)
  
  instance IsRoute (StaticRoute baseDir) where
    type RouteModel (StaticRoute baseDir) = Model
    routePrism (modelFiles -> files) =
      let enc =
            unStaticRoute
          dec fp =
            StaticRoute fp <$ guard (Map.member fp files)
       in toPrism_ $ prism' enc dec
    routeUniverse (modelFiles -> files) =
      StaticRoute <$> Map.keys files
  
  instance (KnownSymbol baseDir) => EmaSite (StaticRoute baseDir) where
    siteInput cliAct _ = do
      files <- staticFilesDynamic $ symbolVal (Proxy @baseDir)
      pure $ Model cliAct <$> files
    siteOutput _ _ (StaticRoute path) =
      pure $ Ema.AssetStatic $ symbolVal (Proxy @baseDir) </> path
  
  staticFilesDynamic ::
    forall m.
    (MonadIO m, MonadUnliftIO m, MonadLogger m, MonadLoggerIO m) =>
    FilePath ->
    m (Dynamic m (Map FilePath UTCTime))
  staticFilesDynamic baseDir = do
    let pats = [((), "**")]
        ignorePats = [".*"]
        model0 = mempty
    Dynamic <$> UnionMount.mount baseDir pats ignorePats model0 (const handleUpdate)
    where
      handleUpdate ::
        FilePath ->
        UnionMount.FileAction () ->
        m (Map FilePath UTCTime -> Map FilePath UTCTime)
      handleUpdate fp = \case
        UnionMount.Refresh _ _ -> do
          lastAccessed <- liftIO getCurrentTime
          pure $ Map.insert fp lastAccessed
        UnionMount.Delete -> do
          pure $ Map.delete fp
  
  -- | Like `Ema.routeUrl`, but looks up the value and appends it to URL in live-server (for force-reload in browser)
  staticRouteUrl ::
    forall s baseDir.
    (IsString s, HasCallStack) =>
    Prism' FilePath (StaticRoute baseDir) ->
    RouteModel (StaticRoute baseDir) ->
    FilePath ->
    s
  staticRouteUrl rp model fp =
    let lastAccessed = lookupMust fp model
        tag = toText $ formatTime defaultTimeLocale "%s" lastAccessed
        url = Ema.routeUrl rp $ StaticRoute fp
     in fromString . toString $ url <> refreshAddendum tag
    where
      -- Force the browser to reload the static file referenced
      refreshAddendum tag =
        fromMaybe "" $ do
          -- In live server, force reload all (re-added/modified) static files.
          -- In statically generated site, do it only for CSS and JS files.
          guard $
            Ema.CLI.isLiveServer (modelCliAction model)
              || takeExtension fp
                `List.elem` [".css", ".js"]
          pure $ "?" <> tag
  
  lookupMust :: FilePath -> Model -> UTCTime
  lookupMust fp model =
    case Map.lookup fp (modelFiles model) of
      Just lastAccessed -> lastAccessed
      Nothing -> throw $ MissingStaticFile fp
  
  newtype MissingStaticFile = MissingStaticFile FilePath
    deriving stock (Eq, Show)
    deriving anyclass (Exception)
  