-- For CompilerToF
{-# LANGUAGE AllowAmbiguousTypes #-}
-- For CompilerToF
{-# LANGUAGE ConstraintKinds #-}
-- For Dataable
{-# LANGUAGE InstanceSigs #-}
-- For Output
{-# LANGUAGE RankNTypes #-}
-- For CompilerToF
{-# LANGUAGE UndecidableInstances #-}

module Literate.Web.Semantics.Compiler where

import Control.Applicative (Applicative (..))
import Control.Monad (Monad (..), forM_)
import Control.Monad.Classes qualified as MC
import Data.Bool
import Data.ByteString.Lazy qualified as BSL
import Data.Either (Either (..))
import Data.Foldable (toList)
import Data.Function (id, ($), (.))
import Data.Functor (Functor (..), (<$>))
import Data.List qualified as List
import Data.Maybe (Maybe (..))
import Data.Proxy (Proxy (..))
import Data.Semigroup (Semigroup (..))
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Tuple (fst, snd)
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'

-- | Interpreter building a static Web site.
--
-- Embed a 'Monad' @m@ to give access to a model if need be.
newtype Compiler m a = Compiler {unCompiler :: m [Output a]}

type instance Sym.ToFEndpoint (Compiler m) a next = (next :~: m BSL.ByteString, a)

contentEndpoint :: a -> Sym.ToFEndpoint (Compiler m) a (m BSL.ByteString)
contentEndpoint = (Refl,)

compile ::
  (MC.MonadExec Sys.IO m) =>
  CompilerEnv ->
  Compiler m a ->
  (a --> m BSL.ByteString) ->
  m ()
compile CompilerEnv{..} router content = do
  outputs <- unCompiler router
  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 content
    MC.exec @Sys.IO $
      BSL.writeFile (compilerEnvDest Sys.</> destPath) $
        bsl

outputBSL :: Output a -> (a --> m BSL.ByteString) -> m BSL.ByteString
outputBSL = outputData

compiler :: Compiler m (m BSL.ByteString) -> Compiler m (m BSL.ByteString)
compiler = id

-- compile2 ::
--   MC.MonadExec Sys.IO m =>
--   CompilerEnv ->
--   Compiler m (m BSL.ByteString) ->
--   m ()
-- compile2 CompilerEnv{..} router = do
--   outputs <- unCompiler router
--   MC.exec @Sys.IO $ Sys.removePathForcibly compilerEnvDest
--   -- FIXME: use pipes
--   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
--     outputBSL <- outputData content
--     MC.exec @Sys.IO $
--       BSL.writeFile (compilerEnvDest Sys.</> destPath) $
--         outputBSL

manifest :: forall m a. (Monad m) => Compiler m a -> m [Sys.FilePath]
manifest router = do
  outputs <- unCompiler router
  return
    [ destPath
    | out <- outputs
    , let destPath =
            ( List.intercalate "." $
                encodePath (outputPath out)
                  : ( if List.null (outputExts out)
                        then ["txt"]
                        else Text.unpack . encodePathSegment <$> outputExts out
                    )
            )
    ]

-- 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
  Compiler a <.> Compiler b = Compiler $ liftA2 (liftA2 (<.>)) a b
  Compiler a <. Compiler b = Compiler $ liftA2 (liftA2 (<.)) a b
  Compiler a .> Compiler b = Compiler $ liftA2 (liftA2 (.>)) a b

-- instance Applicative m => Sym.AlternativeFunctor (Compiler m) where
--  Compiler a <|> Compiler b = Compiler (liftA2 (<>) a b)
instance (Applicative m) => Sym.SumFunctor (Compiler m) where
  Compiler a <+> Compiler b = Compiler $ liftA2 (\as bs -> (a2e <$> as) <> (b2e <$> bs)) a b
    where
      a2e :: Output a -> Output (Either a b)
      a2e o = o{outputData = outputData o . fst}
      b2e :: Output b -> Output (Either a b)
      b2e o = o{outputData = outputData o . snd}

instance (Applicative m, Sym.ToFable a) => Optionable a (Compiler m) where
  optional (Compiler ma) = Compiler $ (\as -> (a2n <$> as) <> (a2j <$> as)) <$> ma
    where
      a2n :: Output a -> Output (Maybe a)
      a2n o = o{outputData = ($ Nothing)}
      a2j :: Output a -> Output (Maybe a)
      a2j o = o{outputData = \k -> outputData o $ Sym.tofOffun $ k . Just}

--   optional (Compiler ma) = Compiler $ (\as -> (a2n <$> as) <> (a2j <$> as)) <$> ma
--     --pure Nothing Sym.<|> (Just <$> ma)
--     where
--     a2n :: Output a -> Output (Maybe a)
--     a2n o = o{ outputData = fst }
--     a2j :: Output a -> Output (Maybe a)
--     a2j o = o{ outputData = outputData o . snd }
--

instance
  ( Generic a
  , Sym.RepOfEoT a
  , sem ~ Compiler m
  , Sym.IsToF a ~ 'False
  , eot ~ Sym.EoT (Sym.ADT a)
  , Sym.ToFable eot
  , Functor m
  ) =>
  Dataable a (Compiler m)
  where
  dataType :: sem (Sym.EoT (Sym.ADT a)) -> sem a
  dataType (Compiler mos) = Compiler ((dataType <$>) <$> mos)
instance
  ( Generic a
  , Sym.RepOfEoT a
  , sem ~ Output
  , Sym.IsToF a ~ 'False
  , eot ~ Sym.EoT (Sym.ADT a)
  , Sym.ToFable eot
  ) =>
  Dataable a Output
  where
  dataType :: sem (Sym.EoT (Sym.ADT a)) -> sem a
  dataType o = o{outputData = \k -> (outputData o) $ Sym.tofOffun $ k . Sym.adtOfeot}
instance (Applicative m) => PathSegmentable (Compiler m) where
  pathSegment s =
    Compiler $
      pure
        [ Output
            { outputPath = [s]
            , outputExts = []
            , outputData = id
            }
        ]
instance
  ( Applicative m
  , n ~ m
  , MimeTypes ts (MimeEncodable a)
  ) =>
  Responsable a ts n (Compiler m)
  where
  response =
    Compiler $
      pure $
        ( \(_mediaType, MimeType (Proxy :: Proxy t)) ->
            Output
              { outputPath = []
              , outputExts = [decodePathSegment (fileExtension @t)]
              , outputData = \(Refl, Response ma) -> mimeEncode @_ @t <$> ma
              }
        )
          <$> toList (mimeTypesMap @ts @(MimeEncodable a))

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

-- ** Type 'Output'

-- TODO: use Seq instead of []
data Output a = Output
  { outputPath :: [PathSegment]
  , outputExts :: [PathSegment]
  , outputData :: forall next. (a --> next) -> next
  }
instance Sym.ProductFunctor Output where
  a <.> b =
    Output
      { outputPath = outputPath a <> outputPath b
      , outputExts = outputExts a <> outputExts b
      , outputData = outputData b . outputData a
      }
  a <. b =
    Output
      { outputPath = outputPath a <> outputPath b
      , outputExts = outputExts a <> outputExts b
      , outputData = outputData b . outputData a
      }
  a .> b =
    Output
      { outputPath = outputPath a <> outputPath b
      , outputExts = outputExts a <> outputExts b
      , outputData = outputData b . outputData a
      }

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

copyDirRecursively ::
  (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" :: Text, 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" :: Text, srcAbs)
          return ()
        -- throw $ StaticAssetMissing srcAbs
        True -> do
          Sys.hPutStrLn Sys.stderr $ "copyDirRecursively: " <> show ("srcAbs is a directory" :: Text, 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