----------------------------------------------------------------------
--
-- Module      :   watching files for changes
-- restart bake
-- include running server
----------------------------------------------------------------------
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

module ShakeBake.Watch where

-- import Lib.CmdLineArgs (PubFlags (..))
import Foundational.SettingsPage
import Foundational.CmdLineFlags

import ShakeBake.Shake2 (shakeAll)
import Uniform.Watch (
    Glob (..),
    WatchOpType,
    makeWatch, --  mainWatch2, forkIO, killThread)
    watchMain,
 )
import Uniform.WebServer (Port, runScotty)
import UniformBase

mainWatch :: NoticeLevel -> Settings -> PubFlags -> ErrIO ()

{- | the landing page must be given here because it is special for scotty
 and the name of the banner imgage which must be copied by shake
-}
mainWatch :: NoticeLevel -> Settings -> PubFlags -> ErrIO ()
mainWatch NoticeLevel
debug Settings
sett3 PubFlags
flags = do
    let layout :: SiteLayout
layout = (Settings -> SiteLayout
siteLayout Settings
sett3)
    let port :: Int
port = (Settings -> Int
localhostPort Settings
sett3)

    let bakedPath :: Path Abs Dir
bakedPath = SiteLayout -> Path Abs Dir
bakedDir SiteLayout
layout
        doughPath :: Path Abs Dir
doughPath = SiteLayout -> Path Abs Dir
doughDir SiteLayout
layout
    let watchDough2, watchThemes2 :: WatchOpType
        watchDough2 :: WatchOpType
watchDough2 =
            forall {a} {b} {c}. a -> b -> c -> (a, b, c)
makeWatch
                Path Abs Dir
doughPath
                (NoticeLevel -> Settings -> PubFlags -> FilePath -> ErrIO ()
shakeAll NoticeLevel
debug Settings
sett3 PubFlags
flags)
                [Text -> Glob
Glob Text
"**/*.md", Text -> Glob
Glob Text
"**/*.bib", Text -> Glob
Glob Text
"**/*.yaml"]

        watchThemes2 :: WatchOpType
watchThemes2 =
            forall {a} {b} {c}. a -> b -> c -> (a, b, c)
makeWatch
                Path Abs Dir
doughPath
                (NoticeLevel -> Settings -> PubFlags -> FilePath -> ErrIO ()
shakeAll NoticeLevel
debug Settings
sett3 PubFlags
flags)
                [ Text -> Glob
Glob Text
"**/*.yaml"
                , Text -> Glob
Glob Text
"**/*.dtpl"
                , Text -> Glob
Glob Text
"**/*.css"
                , Text -> Glob
Glob Text
"**/*.jpg"
                , Text -> Glob
Glob Text
"**/*.JPG"
                ]

    [WatchOpType] -> ErrIO () -> ErrIO ()
watchMain
        [WatchOpType
watchDough2, WatchOpType
watchThemes2]
        ( Int -> Path Abs Dir -> Path Rel File -> ErrIO ()
runScotty
            Int
port
            Path Abs Dir
bakedPath
            (FilePath -> Path Rel File
makeRelFile FilePath
"index.html")
        )