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)
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)


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
    sequence
      [ sigD entryName [t|[(Route EmbeddedStatic, MimeType)]|]
      , funD entryName
          [ clause [] (normalB . listE . map (\(n, mime) -> tupE [varE n, TH.lift mime]) $ nubOn fst entries) []
          ]
      ]
  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