module Settings.StaticFiles.Webpack
  ( mkWebpackEntrypoints
  ) where

import ClassyPrelude

import Language.Haskell.TH
import Language.Haskell.TH.Syntax hiding (Lift(..))
import qualified Language.Haskell.TH.Syntax as TH (Lift(..))

import qualified Data.Yaml as Yaml

import qualified Data.Map as Map

import Yesod.Core (Route, MonadLogger, MonadWidget, HandlerSite, logDebugS, logErrorS)
import Yesod.EmbeddedStatic (EmbeddedStatic)
import Yesod.EmbeddedStatic.Types
import Network.Mime (MimeType)

import Control.Lens.Indexed (iforM)

import Control.Monad.Writer.Class (MonadWriter(..))
import Control.Monad.Trans.Writer.Lazy (execWriterT)
import Control.Monad.Catch (MonadThrow(..))

import Utils (nubOn)

import System.FilePath (makeRelative)

import Text.Shakespeare.Text (st)


mkWebpackEntrypoints :: FilePath -- ^ Path to YAML-manifest
                     -> [FilePath -> Generator]
                     -> FilePath -- ^ Path to static dir
                     -> DecsQ
mkWebpackEntrypoints manifest mkGen stDir = do
  addDependentFile manifest
  entrypoints <- decodeManifest manifest

  staticEntries <- concat <$> mapM ($ stDir) mkGen

  fmap (concat . Map.elems) . iforM entrypoints $ \entrypoint files -> do
    entries <- execWriterT . forM_ files $ \file -> do
      let fileEntries = filter (\entry -> makeRelative stDir (ebLocation entry) == file) staticEntries
      forM_ fileEntries $ \entry -> case ebHaskellName entry of
        Nothing -> lift . reportWarning $ concat
          [ "Entry “"
          , ebLocation entry
          , "” of file “"
          , file
          , "” of webpack entrypoint “"
          , entrypoint
          , "” has no haskellName"
          ]
        Just n -> tell $ pure (n, ebMimeType entry)

    let entryName = mkName $ "webpackEntrypoint_" <> entrypoint
        widgetName = mkName $ "webpackLinks_" <> entrypoint

    staticR <- newName "staticR"
    sequence
      [ sigD entryName [t|[(Route EmbeddedStatic, MimeType)]|]
      , funD entryName
          [ clause [] (normalB . listE . map (\(n, mime) -> tupE [varE n, TH.lift mime]) $ nubOn fst entries) []
          ]
      , sigD widgetName [t|forall m. (MonadLogger m, MonadWidget m) => (Route EmbeddedStatic -> Route (HandlerSite m)) -> m ()|]
      , funD widgetName
          [ clause [varP staticR] (normalB [e|
              do
                $logDebugS "siteLayout" $ tshow $(varE entryName)
                forM_ $(varE entryName) $ \(sRoute, mime) ->
                  let ctEq = (==) `on` simpleContentType
                   in if
                        | mime `ctEq` "text/css"
                          -> addStylesheet $ $(varE staticR) sRoute
                        | mime `ctEq` "application/javascript"
                          -> addScript $ $(varE staticR) sRoute
                        | otherwise
                          -> $logErrorS "siteLayout" [st|Unknown mime type in webpack bundle: #{tshow mime}|]
            |]) []
          ]
      ]
  where
    decodeManifest :: FilePath -> Q (Map String [FilePath])
    decodeManifest manifest' = do
      res <- liftIO $ Yaml.decodeFileWithWarnings manifest'
      case res of
        Left exc -> throwM exc
        Right (ws, res') -> res' <$ mapM_ (\w -> reportWarning $ "Warning while parsing webpack manifest: " <> show w) ws