{-# LANGUAGE DeriveFunctor #-}

module Webc.Compiler where

import Control.Applicative (Applicative (..))
import Control.Monad (Monad (..), forM_, when)
import Data.Bool
import Data.ByteString.Lazy qualified as BSL
import Data.Either (Either (..))
import Data.Eq (Eq (..))
import Data.Foldable (null, toList)
import Data.Function (($), (.))
import Data.Functor (Functor (..), (<$>))
import Data.Maybe (Maybe (..))
import Data.Ord (Ord (..))
import Data.Semigroup (Semigroup (..))
import Data.Text qualified as Text
import GHC.Base (error)
import GHC.Stack (HasCallStack)
import Network.URI.Slug (Slug)
import Network.URI.Slug qualified as URI
import Symantic (
  Optionable (..),
  ProductFunctor (..),
  SumFunctor (..),
 )
import Symantic.Classes (Iso (..), IsoFunctor (..))
import System.Directory (copyFile, createDirectoryIfMissing, doesDirectoryExist, doesFileExist, doesPathExist {-, getCurrentDirectory-})
import System.FilePath (FilePath, takeDirectory, (</>))
import System.FilePath qualified as FilePath
import System.FilePattern.Directory (getDirectoryFiles)
import System.IO (IO, hPutStrLn, stderr)
import Text.Show (Show (..))
import Webc.Classes hiding ((</>))
import Webc.MIME (PlainText)

-- * The 'Compiler' interpreter

newtype Compiler a = Compiler
  { unCompiler :: [Comp a]
  }
  deriving (Functor, Show)

instance Applicative Compiler where
  pure = Compiler . pure . pure
  Compiler f <*> Compiler x = Compiler $ (<*>) <$> f <*> x

-- instance Monad Compiler where
--   return = pure
--   Compiler x >>= f = Compiler (x >>=)

data CompilerConf = CompilerConf
  { compilerConfSource :: FilePath
  , compilerConfDest :: FilePath
  }

compile :: Show a => Renderable a => Compiler a -> CompilerConf -> IO ()
compile comp CompilerConf{..} = do
  createDirectoryIfMissing True compilerConfDest
  let routes = unCompiler comp
  when (null routes) $
    error "no routes, nothing to compile"
  forM_ routes $ \c@Comp{..} -> do
    hPutStrLn stderr $ "route: " <> show c
    let routePath = pathOfSlugs compSlugs
     in case render c of
          Left staticPath ->
            doesPathExist (compilerConfSource </> staticPath) >>= \case
              True -> do
                -- TODO: In current branch, we don't expect this to be a directory.
                -- Although the user may pass it, but review before merge.
                hPutStrLn stderr $
                  "staticCopy: "
                    <> show
                      ( (compilerConfSource </> staticPath)
                      , (compilerConfDest </> staticPath)
                      )
                copyDirRecursively
                  routePath
                  (compilerConfSource </> staticPath)
                  (compilerConfDest </> staticPath)
              False ->
                return ()
          -- log LevelWarn $ toText $ "? " <> staticPath <> " (missing)"
          Right (bs, ext) -> do
            hPutStrLn stderr $ "mkdir: " <> show (takeDirectory (compilerConfDest </> routePath))
            createDirectoryIfMissing True (takeDirectory (compilerConfDest </> routePath))
            hPutStrLn stderr $ "write: " <> show (compilerConfDest </> routePath FilePath.<.> ext)
            BSL.writeFile (compilerConfDest </> routePath FilePath.<.> ext) bs

-- ** Class 'Renderable'
class Renderable a where
  render :: Comp a -> Either FilePath (BSL.ByteString, FilePath)
instance Renderable () where
  render Comp{..} = Left $ pathOfSlugs compSlugs

pathOfSlugs :: [Slug] -> FilePath
pathOfSlugs s = Text.unpack $ Text.intercalate "/" $ URI.encodeSlug <$> s

-- ** Type 'Comp'
data Comp a = Comp
  { compSlugs :: [Slug] -- TODO: Endo? Seq?
  , compValue :: a
  , compExt :: Maybe FilePath
  }
  deriving (Eq, Ord, Show, Functor)
instance Applicative Comp where
  pure compValue =
    Comp
      { compSlugs = []
      , compValue
      , compExt = Nothing
      }
  f <*> x =
    Comp
      { compSlugs = compSlugs f <> compSlugs x
      , compValue = compValue f (compValue x)
      , compExt = compExt f <> compExt x
      }

instance IsoFunctor Compiler where
  (<%>) Iso{..} = (a2b <$>)
instance ProductFunctor Compiler where
  (<.>) = liftA2 (,)
  (<.) = (<*)
  (.>) = (*>)
instance SumFunctor Compiler where
  x <+> y =
    Compiler $
      (<>)
        ((Left <$>) <$> unCompiler x)
        ((Right <$>) <$> unCompiler y)
instance Optionable Compiler where
  optional x =
    Compiler $
      Comp{compSlugs = [], compValue = Nothing, compExt = Nothing} :
      ((Just <$>) <$> unCompiler x)
instance Slugable Compiler where
  literalSlug s = Compiler [Comp{compSlugs = [s], compValue = (), compExt = Nothing}]
  chooseSlug ss =
    Compiler $
      [ Comp{compSlugs = [s], compValue = s, compExt = Nothing}
      | s <- toList ss
      ]
instance ContentTypeable PlainText () Compiler where
  contentType =
    Compiler
      [ Comp
          { compSlugs = []
          , compValue = ()
          , compExt = Just "txt"
          }
      ]

-- instance Repeatable Compiler where
--   many0 (Compiler x) =
--     Compiler $
--       ((\Comp{} -> Comp [] []) <$> x)
--         <> ((\(Comp s a) -> Comp s [a]) <$> x)
--         <> ((\(Comp s a) -> Comp (s <> s) [a, a]) <$> x)
--   many1 (Compiler x) =
--     Compiler $
--       ((\(Comp s a) -> Comp s [a]) <$> x)
--         <> ((\(Comp s a) -> Comp (s <> s) [a, a]) <$> x)
-- instance Endable Compiler where
--   end = Compiler [Comp [] ()]
-- instance Capturable Compiler where
--   captureSlug n = Compiler $ [Comp [n] n]
-- instance Constantable c Compiler where
--   constant = pure

{-
let (staticPaths, generatedPaths) =
      lefts &&& rights $
        routes <&> \r ->
          case render model r of
            AssetStatic fp -> Left (r, fp)
            AssetComperated _fmt s -> Right (encodeRoute model r, s)
paths <- forM generatedPaths $ \(relPath, !s) -> do
  let fp = dest </> relPath
  log LevelInfo $ toText $ "W " <> fp
  liftIO $ do
    createDirectoryIfMissing True (takeDirectory fp)
    writeFileLBS fp s
    pure fp
forM_ staticPaths $ \(r, staticPath) -> do
  liftIO (doesPathExist staticPath) >>= \case
    True ->
      -- TODO: In current branch, we don't expect this to be a directory.
      -- Although the user may pass it, but review before merge.
      copyDirRecursively (encodeRoute model r) staticPath dest
    False ->
      log LevelWarn $ toText $ "? " <> staticPath <> " (missing)"
-}
{-
instance Slugable Compiler where
  literalSlug s = Compiler $ return $ Endo (s :)
  captureSlug _n = Compiler $ MT.ReaderT $ \s -> return $ Endo (s :)
instance ProductFunctor Compiler where
  Compiler x <.> Compiler y = Compiler $
    MT.ReaderT $ \env ->
      MT.withReaderT (\env -> env{compilerArgs = b2a (compilerArgs env)})
      return $
        MT.runReaderT x a
          <> MT.runReaderT y b
-}

--deriving stock (Eq, Show, Ord, Comperic)

{-

safeForLarge' :: Int -> IO ()
safeForLarge' n = flip finally (cleanup tmpfile) $ do
    cleanup tmpfile
    lgrset <- newFileLoggerSet defaultBufSize tmpfile
    let xs = toLogStr $ BS.pack $ take (abs n) (cycle ['a'..'z'])
        lf = "x"
    pushLogStr lgrset $ xs <> lf
    flushLogStr lgrset
    rmLoggerSet lgrset
    bs <- BS.readFile tmpfile
    bs `shouldBe` BS.pack (take (abs n) (cycle ['a'..'z']) <> "x")
    where
        tmpfile = "test/temp"

cleanup :: FilePath -> IO ()
cleanup file = do
    exist <- doesFileExist file
    when exist $ removeFile file

logAllMsgs :: IO ()
logAllMsgs = logAll "LICENSE" `finally` cleanup tmpfile
  where
    tmpfile = "test/temp"
    logAll file = do
        cleanup tmpfile
        lgrset <- newFileLoggerSet 512 tmpfile
        src <- BS.readFile file
        let bs = (<> "\n") . toLogStr <$> BS.lines src
        mapM_ (pushLogStr lgrset) bs
        flushLogStr lgrset
        rmLoggerSet lgrset
        dst <- BS.readFile tmpfile
        dst `shouldBe` src

compile ::
  forall model m route.
  ( -- MonadIO m,
    -- MonadUnliftIO m,
    -- MonadLoggerIO m,
    -- Show r,
    HasCallStack
  ) =>
  FilePath ->
  model ->
  (model -> route -> Asset BSL.ByteString) ->
  -- | List of generated files.
  IO ()
compile dest model render = do
  dirExists <- doesDirectoryExist dest
  when (not dirExists) $ do
    error $ "Destination does not exist: " <> dest
  let routes = allRoutes model
  when (null routes) $
    error "allRoutes is empty; nothing to compile"
  -- log LevelInfo $ "Writing " <> show (length routes) <> " routes"
  let staticPaths =
          (<$> routes) $ \route ->
            case render model route of
              AssetStatic fp -> Left (route, fp)
              AssetComperated _fmt s -> Right (encodeRoute model route, s)
  forM_ staticPaths $ \(route, staticPath) -> do
    (doesPathExist staticPath) >>= \case
      True ->
        -- TODO: In current branch, we don't expect this to be a directory.
        -- Although the user may pass it, but review before merge.
        copyDirRecursively (encodeRoute model route) staticPath dest
      False ->
        return ()
        -- log LevelWarn $ toText $ "? " <> staticPath <> " (missing)"

log :: MonadLogger m => LogLevel -> Text -> m ()
log = logWithoutLoc "Comperate"

-- | 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 -> pure ()
    False -> do
      log LevelInfo $ "Disabling Jekyll by writing " <> toText nojekyll
      writeFileLBS nojekyll ""

newtype StaticAssetMissing = StaticAssetMissing FilePath
  deriving stock (Show)
  deriving anyclass (Exception)

-}
copyDirRecursively ::
  ( --MonadIO m,
    --MonadUnliftIO m,
    --MonadLoggerIO m,
    HasCallStack
  ) =>
  -- | Source file path relative to CWD
  FilePath ->
  -- | Absolute path to source file to copy.
  FilePath ->
  -- | Directory *under* which the source file/dir will be copied
  FilePath ->
  IO ()
copyDirRecursively srcRel srcAbs destParent = do
  doesFileExist srcAbs >>= \case
    True -> do
      let b = destParent </> srcRel
      --log LevelInfo $ toText $ "C " <> b
      copyFileCreatingParents srcAbs b
    False ->
      doesDirectoryExist srcAbs >>= \case
        False ->
          return ()
        -- throw $ StaticAssetMissing srcAbs
        True -> do
          fs <- getDirectoryFiles srcAbs ["**"]
          forM_ fs $ \fp -> do
            let a = srcAbs </> fp
                b = destParent </> srcRel </> fp
            -- log LevelInfo $ toText $ "C " <> b
            copyFileCreatingParents a b
  where
    copyFileCreatingParents a b = do
      createDirectoryIfMissing True (takeDirectory b)
      copyFile a b