-- For Dataable instances
{-# LANGUAGE InstanceSigs #-}
-- For Output
{-# LANGUAGE RankNTypes #-}
-- For Dataable instances
{-# 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.Eq (Eq)
import Data.Foldable (toList)
import Data.Function (id, ($), (.))
import Data.Functor (Functor (..), (<$>))
import Data.List qualified as List
import Data.Map.Strict qualified as Map
import Data.Maybe (Maybe (..))
import Data.Monoid (Monoid (..))
import Data.Ord (Ord)
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 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 ((:~:) (..))

import Literate.Web.Syntaxes
import Literate.Web.Types.MIME
import Literate.Web.Types.URL

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

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

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

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 $ \out -> do
    let outFullPath = outputPathFile (outputPathRelative out)
    -- MC.exec $ Sys.hPutStrLn Sys.stderr $ "mkdir: " <> show (Sys.takeDirectory outFullPath)
    MC.exec @Sys.IO $
      Sys.createDirectoryIfMissing True $
        compilerEnvDest Sys.</> Sys.takeDirectory outFullPath
    -- MC.exec $ Sys.hPutStrLn Sys.stderr $ "write: " <> show outFullPath
    bsl <- outputData out content
    MC.exec @Sys.IO $ BSL.writeFile (compilerEnvDest Sys.</> outFullPath) bsl

siteManifest :: Monad m => Compiler m a -> m [Sys.FilePath]
siteManifest router = (outputPathFile . outputPathRelative <$>) <$> unCompiler router

siteMap ::
  Monad m =>
  Compiler m a ->
  (a --> m BSL.ByteString) ->
  m (Map.Map OutputPath (m BSL.ByteString))
siteMap router content = do
  outputs <- unCompiler router
  return $
    Map.fromList
      [ (outputPathRelative out, outputData out content)
      | out <- outputs
      ]

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

-- 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 -> forNothing : (forJust <$> as)) <$> ma
    where
      forNothing :: Output (Maybe a)
      forNothing = Output{outputPath = mempty, outputData = ($ Nothing)}
      forJust :: Output a -> Output (Maybe a)
      forJust o = o{outputData = \k -> outputData o $ Sym.tofOffun $ k . Just}

--   optional (Compiler ma) = Compiler $ (\as -> forNothing : (forJust <$> as)) <$> ma
--     --pure Nothing Sym.<|> (Just <$> ma)
--     where
--     forNothing :: Output a -> Output (Maybe a)
--     forNothing o = o{ outputData = fst }
--     forJust :: Output a -> Output (Maybe a)
--     forJust 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 =
                OutputPath
                  { outputPathSegs = [s]
                  , outputPathExts = []
                  }
            , 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 =
                  OutputPath
                    { outputPathSegs = []
                    , outputPathExts = [decodePathSegment (fileExtension @t)]
                    }
              , outputData = \(Refl, Response ma) -> mimeEncode @_ @t <$> ma
              }
        )
          <$> toList (mimeTypesMap @ts @(MimeEncodable a))

-- ** Type 'Output'

data Output a = Output
  { outputPath :: OutputPath
  , outputData :: forall next. (a --> next) -> next
  }

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

outputPathRelative :: Output a -> OutputPath
outputPathRelative out
  | List.null (outputPathExts outPath) = outPath{outputPathExts = ["txt"]}
  | otherwise = outPath
  where
    outPath = outputPath out

-- *** Type 'OutputPath'
data OutputPath = OutputPath
  { outputPathSegs :: [PathSegment]
  , outputPathExts :: [PathSegment]
  }
  deriving (Eq, Ord)

outputPathFile :: OutputPath -> Sys.FilePath
outputPathFile outPath =
  List.intercalate "." $
    encodePath (outputPathSegs outPath)
      : (Text.unpack . encodePathSegment <$> outputPathExts outPath)

instance Semigroup OutputPath where
  x <> y =
    OutputPath
      { outputPathSegs = outputPathSegs x <> outputPathSegs y
      , outputPathExts = outputPathExts x <> outputPathExts y
      }
instance Monoid OutputPath where
  mempty = OutputPath{outputPathSegs = [], outputPathExts = []}

instance Sym.ProductFunctor Output where
  a <.> b =
    Output
      { outputPath = outputPath a <> outputPath b
      , outputData = outputData b . outputData a
      }
  a <. b =
    Output
      { outputPath = outputPath a <> outputPath b
      , outputData = outputData b . outputData a
      }
  a .> b =
    Output
      { outputPath = outputPath a <> outputPath 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 outputFullPath = compilerEnvDest </> routePath
--                            {-
--                            maybe (routePath </> compilerEnvIndex)
--                                  (routePath Sys.FilePath.<.>)
--                                  (compType comp)
--                           -}
--             -- Sys.hPutStrLn Sys.stderr $ "mkdir: " <> show (Sys.takeDirectory outputFullPath)
--             createDirectoryIfMissing True (Sys.takeDirectory outputFullPath)
--             -- Sys.hPutStrLn Sys.stderr $ "write: " <> show outputFullPath
--             BSL.writeFile outputFullPath 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