-- For Output
{-# LANGUAGE DeriveFunctor #-}

module Literate.Web.Semantics.Compiler where

import Control.Applicative (Applicative (..))
import Control.Monad (Monad (..), forM, forM_, join, sequence, (>=>))
import Control.Monad.Classes qualified as MC
import Control.Monad.Trans.Class qualified as MT
import Control.Monad.Trans.Reader qualified as MT
import Data.Bool
import Data.ByteString.Lazy qualified as BSL
import Data.Either (Either (..))
import Data.Eq (Eq (..))
import Data.Foldable (toList)
import Data.Function (const, id, ($), (.))
import Data.Functor (Functor (..), (<$>))
import Data.Kind (Constraint, Type)
import Data.List qualified as List
import Data.Maybe (Maybe (..))
import Data.Ord (Ord (..))
import Data.Proxy (Proxy (..))
import Data.Semigroup (Semigroup (..))
import Data.String (fromString)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Tuple (curry)
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import Literate.Web.Syntaxes
import Literate.Web.Types.MIME
import Literate.Web.Types.URL
import Symantic qualified as Sym
import System.Directory qualified as Sys
import System.FilePath qualified as Sys
import System.FilePattern.Directory qualified as Sys
import System.IO qualified as Sys
import Text.Show (Show (..))
import Type.Reflection ((:~:) (..))

-- * Type 'Compiler'
newtype Compiler m a = Compiler {unCompiler :: m [Output a]}
  deriving (Functor)

compile ::
  MC.MonadExec Sys.IO m =>
  CompilerEnv ->
  Sym.ToFer (Compiler m) a ->
  Sym.ToF a (m BSL.ByteString) ->
  m ()
compile CompilerEnv{..} router content = do
  outputs <- unCompiler $ Sym.tuplesOfFunctions router content
  MC.exec @Sys.IO $ Sys.removePathForcibly compilerEnvDest
  forM_ outputs $ \Output{..} -> do
    let destPath =
          ( List.intercalate "." $
              encodePath outputPath :
              ( if List.null outputExts
                  then ["txt"]
                  else Text.unpack . encodePathSegment <$> outputExts
              )
          )
    -- hPutStrLn stderr $ "mkdir: " <> show (Sys.takeDirectory destPath)
    MC.exec @Sys.IO $
      Sys.createDirectoryIfMissing True $
        compilerEnvDest Sys.</> Sys.takeDirectory destPath
    -- hPutStrLn stderr $ "write: " <> show destPath
    bsl <- outputData
    MC.exec @Sys.IO $
      BSL.writeFile (compilerEnvDest Sys.</> destPath) $
        bsl

manifest ::
  forall m a.
  Monad m =>
  Sym.ToFer (Compiler m) a ->
  Sym.ToF a (m BSL.ByteString) ->
  m [Sys.FilePath]
manifest router content = do
  outputs <- unCompiler $ Sym.tuplesOfFunctions router content
  forM outputs $ \(Output{..} :: Output (m BSL.ByteString)) -> do
    let destPath =
          ( List.intercalate "." $
              encodePath outputPath :
              ( if List.null outputExts
                  then ["txt"]
                  else Text.unpack . encodePathSegment <$> outputExts
              )
          )
    return destPath

instance Applicative m => Applicative (Compiler m) where
  pure = Compiler . pure . pure . pure
  liftA2 f (Compiler a) (Compiler b) = Compiler (liftA2 (liftA2 (liftA2 f)) a b)
instance Monad m => Monad (Compiler m) where
  return = pure
  Compiler mloa >>= a2mlob =
    Compiler $ do
      mloa >>= \loa ->
        (join <$>) $
          forM loa $ \oa -> do
            lob <- unCompiler $ a2mlob $ outputData oa
            forM lob $ \ob ->
              return
                ob
                  { outputPath = outputPath oa <> outputPath ob
                  , outputExts = outputExts oa <> outputExts ob
                  }
instance Applicative m => Sym.ProductFunctor (Compiler m) where
  (<.>) = liftA2 (,)
  (<.) = liftA2 const
  (.>) = liftA2 (const id)
instance Applicative m => Sym.AlternativeFunctor (Compiler m) where
  Compiler a <|> Compiler b = Compiler (liftA2 (<>) a b)
instance Applicative m => Sym.SumFunctor (Compiler m) where
  a <+> b = Left <$> a Sym.<|> Right <$> b
instance Applicative m => Sym.Optionable (Compiler m) where
  optional ma = pure Nothing Sym.<|> (Just <$> ma)
instance Applicative m => PathSegmentable (Compiler m) where
  pathSegment s = Compiler $ pure [Output{outputPath = [s], outputExts = [], outputData = ()}]
instance
  ( Show a
  , Monad m
  , n ~ m
  , MimeTypes ts (MimeEncodable a)
  ) =>
  Responsable a ts n (m BSL.ByteString) (Sym.ToFer (Compiler m))
  where
  response =
    Sym.ToFer
      { tuplesOfFunctions = \(Refl, Response ma) ->
          Compiler $ do
            a <- ma
            pure $
              ( \(mt, MimeType (Proxy :: Proxy t)) ->
                  Output
                    { outputPath = []
                    , outputExts = [decodePathSegment (fileExtension @t)]
                    , outputData = pure $ mimeEncode @_ @t a
                    }
              )
                <$> toList (mimeTypesMap @ts @(MimeEncodable a))
      , eithersOfTuples = Compiler $ pure []
      }

-- ** Type 'CompilerEnv'
data CompilerEnv = CompilerEnv
  { compilerEnvDest :: Sys.FilePath
  , -- , compilerEnvSource :: Sys.FilePath
    compilerEnvIndex :: Sys.FilePath
    --, compilerEnvModel :: model
    -- , compilerEnvPath :: [PathSegment]
  }
  deriving (Show)

-- ** Type 'Output'
data Output a = Output
  { outputPath :: [PathSegment]
  , outputExts :: [PathSegment]
  , outputData :: a
  -- , outputType :: MimeType (MimeEncodable a)
  }
  deriving (Functor, Show)
instance Applicative Output where
  pure a =
    Output
      { outputPath = []
      , outputExts = []
      , outputData = a
      -- , outputType = mediaType @PlainText
      }
  oa2b <*> oa =
    Output
      { outputPath = outputPath oa2b <> outputPath oa
      , outputExts = outputExts oa2b <> outputExts oa
      , outputData = outputData oa2b (outputData oa)
      -- , outputType = outputType f <> outputType x
      }

-- -- pathSegments _ss = Compiler $
-- --   MT.ReaderT $ \s ->
-- --     -- TODO: assert Set.member s ss
-- --     lift $
-- --       MT.modify' $ \st ->
-- --         st{compilerStatePath = compilerStatePath st </> Text.unpack (encodePathSegment s)}
--
-- {-
-- instance
--   TypeError (
--     'Text "The instance (Capturable a Compiler)"
--     ':$$: 'Text "is disabled when compiling to a static Web site."
--     ':$$: 'Text "You can use (whenInterpreter @Compiler siteNotUsingCapturable siteUsingCapturable)"
--     ':$$: 'Text "to replace calls to any method of Capturable."
--   ) => Capturable a Compiler where
--   capturePathSegment = undefined
-- instance
--   TypeError (
--     'Text "The instance (Capturable a (Reader model Compiler))"
--     ':$$: 'Text "is disabled when compiling to a static Web site."
--     ':$$: 'Text "You can use (whenInterpreter @(Reader model Compiler) siteNotUsingCapturable siteUsingCapturable)"
--     ':$$: 'Text "to replace calls to any method of Capturable."
--   ) => Capturable a (Reader model Compiler) where
--   capturePathSegment = undefined
-- -}
--
-- -- choosePathSegments _s = Compiler $ MT.ReaderT $ \s -> return $ Endo (List.reverse s <>)
-- {-
-- instance Capturable Compiler where
--   type CapturableConstraint Compiler =
--   capturePathSegment _n = Compiler $ MT.ReaderT $ \s ->
--     lift $ MT.modify' $ \st ->
--       st{compilerStatePath = compilerStatePath st </> Text.unpack (encodePathSegment s)}
-- -}
-- {-
-- instance Copyable Compiler where
--   copy path = Compiler $
--     lift $
--       MT.ReaderT $ \env -> do
--         lift $ do
--           doesPathExist (compilerEnvSource env </> path) >>= \case
--             True -> do
--               Sys.hPutStrLn Sys.stderr $
--                 "staticCopy: "
--                   <> show
--                     ( (compilerEnvSource env </> path)
--                     , (compilerEnvDest env </> path)
--                     )
--               copyDirRecursively
--                 path
--                 (compilerEnvSource env </> path)
--                 (compilerEnvDest env)
--             False -> do
--               Sys.hPutStrLn Sys.stderr $ "error: path does not exist: " <> (compilerEnvSource env </> path)
-- instance Encodable fmt a => Contentable fmt a Compiler where
--   content = Compiler $
--     MT.ReaderT $ \a -> MT.ReaderT $ \env -> do
--       st <- MT.get
--       let destPath = compilerEnvDest env </> compilerStatePath st
--       lift $ do
--         -- Sys.hPutStrLn Sys.stderr $ "mkdir: " <> show (Sys.takeDirectory destPath)
--         createDirectoryIfMissing True (Sys.takeDirectory destPath)
--         -- Sys.hPutStrLn Sys.stderr $ "write: " <> show destPath
--         BSL.writeFile destPath $ encode @fmt a
-- -}
-- --instance Endable Compiler where
-- --  end = Compiler $ return $ Endo id
--
-- --pathSegments _cs = Compiler $ MT.ReaderT $ \s -> return $ Endo (s :)
-- -- instance Fileable Compiler where
-- --   type FileableConstraint Compiler = Typeable
-- --   static = Compiler $ MT.ReaderT $ \_a ->
-- --     return $ Endo (\x -> x)
--
-- {-
-- -- * The 'Compiler' interpreter
--
-- -- | Create files according to the given model of type 'a'.
-- newtype Compiler a = Compiler
--   { unCompiler :: [Comp a]
--   }
--   deriving (Show, Functor)
--
-- 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 >>=)
--
-- compile :: Show a => Renderable a => Compiler a -> CompilerEnv -> Sys.IO ()
-- compile compiler conf@CompilerEnv{..} = do
--   createDirectoryIfMissing True compilerEnvDest
--   let router = unCompiler compiler
--   when (null router) $
--     error "no router, nothing to compile"
--   -- Sys.hPutStrLn Sys.stderr $ "conf: " <> show conf
--   -- forM_ router $ \comp -> do
--   --   Sys.hPutStrLn Sys.stderr $ "route: " <> show comp
--   forM_ router $ \Comp{..} -> do
--     -- Sys.hPutStrLn Sys.stderr $ "route: " <> show comp
--     let routePath = pathOfPathSegments compPathSegments
--      in case render compData of
--           Left staticPath ->
--             doesPathExist (compilerEnvSource </> 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.
--                 Sys.hPutStrLn Sys.stderr $
--                   "staticCopy: "
--                     <> show
--                       ( (compilerEnvSource </> staticPath)
--                       , (compilerEnvDest </> staticPath)
--                       )
--                 copyDirRecursively
--                   staticPath
--                   (compilerEnvSource </> staticPath)
--                   (compilerEnvDest)
--               False -> do
--                 Sys.hPutStrLn Sys.stderr $ "error: path does not exist: " <> (compilerEnvSource </> staticPath)
--           -- log LevelWarn $ toText $ "? " <> staticPath <> " (missing)"
--           Right bs -> do
--             let destPath = compilerEnvDest </> routePath
--                            {-
--                            maybe (routePath </> compilerEnvIndex)
--                                  (routePath Sys.FilePath.<.>)
--                                  (compType comp)
--                           -}
--             -- Sys.hPutStrLn Sys.stderr $ "mkdir: " <> show (Sys.takeDirectory destPath)
--             createDirectoryIfMissing True (Sys.takeDirectory destPath)
--             -- Sys.hPutStrLn Sys.stderr $ "write: " <> show destPath
--             BSL.writeFile destPath bs
--
-- -- ** Class 'Renderable'
-- class Renderable a where
--   render :: a -> Either Sys.FilePath BSL.ByteString
-- instance Renderable () where
--   render () =
--     --Left $ pathOfPathSegments compPathSegments
--     Right BSL.empty
--
-- -- ** Type 'Comp'
-- data Comp a = Comp
--   { compPathSegments :: [PathSegment] -- TODO: Endo? Seq?
--   , compData :: a
--   -- , compType :: MimeType (MimeEncodable a)
--   }
-- deriving instance Eq a => Eq (Comp a)
-- deriving instance Ord a => Ord (Comp a)
-- deriving instance Show a => Show (Comp a)
-- deriving instance Functor Comp
-- instance Applicative Comp where
--   pure compData =
--     Comp
--       { compPathSegments = []
--       , compData
--       -- , compType = mediaType @PlainText
--       }
--   f <*> x =
--     Comp
--       { compPathSegments = compPathSegments f <> compPathSegments x
--       , compData = compData f (compData x)
--       -- , compType = compType f <> compType 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 { compPathSegments = []
--            , compData = Nothing
--            -- , compType = Nothing
--            } :
--       ((Just <$>) <$> unCompiler x)
-- instance PathSegmentable Compiler where
--   pathSegment s = Compiler
--     [
--       Comp
--         { compPathSegments = [s]
--         , compData = ()
--         -- , compType = PlainText
--         }
--     ]
--   pathSegments ss =
--     Compiler $
--       [ Comp{ compPathSegments = [s]
--             , compData = s
--             -- , compType = Nothing
--             }
--       | s <- toList ss
--       ]
-- instance ContentTypeable PlainText () Compiler where
--   contentType =
--     Compiler
--       [ Comp
--           { compPathSegments = []
--           , compData = ()
--           --, compType = mediaType @PlainText
--           }
--       ]
--
-- -- 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
-- --   capturePathSegment n = Compiler $ [Comp [n] n]
-- -- instance Constantable c Compiler where
-- --   constant = pure
-- -}
--
copyDirRecursively ::
  ( --MonadIO m,
    --MonadUnliftIO m,
    --MonadLoggerIO m,
    HasCallStack
  ) =>
  -- | Source file path relative to CWD
  Sys.FilePath ->
  -- | Absolute path to source file to copy.
  Sys.FilePath ->
  -- | Directory *under* which the source file/dir will be copied
  Sys.FilePath ->
  Sys.IO ()
copyDirRecursively srcRel srcAbs destParent = do
  Sys.doesFileExist srcAbs >>= \case
    True -> do
      Sys.hPutStrLn Sys.stderr $ "copyDirRecursively: " <> show ("srcAbs is a file", srcAbs)
      copyFileCreatingParents srcAbs (destParent Sys.</> srcRel)
    False ->
      Sys.doesDirectoryExist srcAbs >>= \case
        False -> do
          Sys.hPutStrLn Sys.stderr $ "copyDirRecursively: " <> show ("srcAbs is neither a file nor directory", srcAbs)
          return ()
        -- throw $ StaticAssetMissing srcAbs
        True -> do
          Sys.hPutStrLn Sys.stderr $ "copyDirRecursively: " <> show ("srcAbs is a directory", srcAbs)
          Sys.createDirectoryIfMissing True (destParent Sys.</> srcRel)
          fs <- Sys.getDirectoryFiles srcAbs ["**"]
          forM_ fs $ \fp -> do
            let a = srcAbs Sys.</> fp
                b = destParent Sys.</> srcRel Sys.</> fp
            copyFileCreatingParents a b
  where
    copyFileCreatingParents a b = do
      Sys.createDirectoryIfMissing True (Sys.takeDirectory b)
      Sys.copyFile a b