module Main where

import ContentStore (initContentStore, loadEnvironment, resolveExportTarget)
import Server (runServer)
import Eval                   (evalTricu, mainResult, result)
import FileEval
import Parser                 (parseTricu)
import REPL
import Research
import Wire

import Control.Monad          (foldM)
import Data.Text              (Text, unpack)
import qualified Data.Text    as T
import Data.Version           (showVersion)
import Paths_tricu            (version)
import System.Console.CmdArgs
import System.Environment     (lookupEnv)
import System.IO              (hPutStrLn, stderr)
import Text.Megaparsec        ()

import qualified Data.ByteString.Lazy as BL
import Database.SQLite.Simple (close)

import qualified Data.Map as Map

data TricuArgs
  = Repl
  | Evaluate { file :: [FilePath], form :: EvaluatedForm }
  | TDecode { file :: [FilePath] }
  | Compile { inputFile :: FilePath, outFile :: FilePath, names :: [String] }
  | Export { hash :: String, exportNameOpt :: String, outFile :: FilePath, names :: [String] }
  | Import { inFile :: FilePath }
  | Serve { host :: String, port :: Int }
  deriving (Show, Data, Typeable)

replMode :: TricuArgs
replMode = Repl
  &= help "Start interactive REPL"
  &= auto
  &= name "repl"

evaluateMode :: TricuArgs
evaluateMode = Evaluate
  { file = def &= help "Input file path(s) for evaluation.\n \
      \ Defaults to stdin."
      &= name "f" &= typ "FILE"
    , form = TreeCalculus &= typ "FORM"
      &= help "Optional output form: (tree|fsl|ast|ternary|ascii|decode).\n \
      \ Defaults to tricu-compatible `t` tree form."
      &= name "t"
  }
  &= help "Evaluate tricu and return the result of the final expression."
  &= explicit
  &= name "eval"

decodeMode :: TricuArgs
decodeMode = TDecode
  { file = def
    &= help "Optional input file path to attempt decoding.\n \
    \ Defaults to stdin."
    &= name "f" &= typ "FILE"
  }
  &= help "Decode a Tree Calculus value into a string representation."
  &= explicit
  &= name "decode"

exportMode :: TricuArgs
exportMode = Export
  { hash = def &= help "Hash or stored term name(s) to export (comma-separated)."
             &= name "h" &= typ "HASH_OR_NAME"
    , exportNameOpt = def &= help "Export name (legacy; use -n NAME for full control)."
             &= name "n" &= typ "NAME"
    , outFile = def &= help "Output file path for the bundle." &= name "o" &= typ "FILE"
    , names = def &= help "Export name(s) for the bundle manifest (comma-separated or repeated -n)."
               &= typ "NAME"
  }
  &= help "Export a Merkle bundle from the content store."
  &= explicit
  &= name "export"

importMode :: TricuArgs
importMode = Import
  { inFile = def &= help "Path to the bundle file to import."
               &= name "f" &= typ "FILE"
  }
  &= help "Import a Merkle bundle into the content store."
  &= explicit
  &= name "import"

compileMode :: TricuArgs
compileMode = Compile
  { inputFile = def &= help "Path to the tricu source file (.tri) to compile."
                  &= name "f" &= typ "FILE"
  , outFile = def &= help "Output bundle file path (.tri.bundle)."
                &= name "o" &= typ "FILE"
  , names = def &= help "Definition name(s) to export as bundle roots (comma-separated or repeated -x). Defaults to 'main'."
              &= name "x" &= typ "NAME"
  }
  &= help "Compile a tricu source file into a standalone Arboricx portable bundle."
  &= explicit
  &= name "compile"

serveMode :: TricuArgs
serveMode = Serve
  { host = "127.0.0.1" &= help "Host to bind the server to." &= name "h" &= typ "HOST"
    , port = 8787 &= help "HTTP port to listen on." &= name "p" &= typ "PORT"
  }
  &= help "Start a read-only HTTP server for exporting Arboricx bundles."
  &= explicit
  &= name "server"

main :: IO ()
main = do
  let versionStr = "tricu Evaluator and REPL " ++ showVersion version
  cmdArgsParsed <- cmdArgs $ modes [replMode, evaluateMode, decodeMode, compileMode, exportMode, importMode, serveMode]
    &= help "tricu: Exploring Tree Calculus"
    &= program "tricu"
    &= summary versionStr
    &= versionArg [explicit, name "version", summary versionStr]
  case cmdArgsParsed of
    Repl -> do
      putStrLn "Welcome to the tricu REPL"
      putStrLn "You may exit with `CTRL+D` or the `!exit` command."
      repl
    Evaluate { file = filePaths, form = outputForm } -> do
      maybeDbPath <- lookupEnv "TRICU_DB_PATH"
      evalResult <- case filePaths of
        [] -> do
            initialEnv <- case maybeDbPath of
              Just _ -> do
                conn <- initContentStore
                env <- loadEnvironment conn
                close conn
                return env
              Nothing -> return Map.empty
            input <- getContents
            pure $ runTricuTEnv initialEnv input
        (_:restFilePaths) -> do
            initialEnv <- case maybeDbPath of
              Just _ -> do
                conn <- initContentStore
                env <- loadEnvironment conn
                close conn
                return env
              Nothing -> return Map.empty
            finalEnv <- foldM evaluateFileWithContext initialEnv restFilePaths
            pure $ mainResult finalEnv
      let fRes = formatT outputForm evalResult
      putStr fRes
    TDecode { file = filePaths } -> do
      value <- case filePaths of
        [] -> getContents
        (filePath:_) -> readFile filePath
      putStrLn $ decodeResult $ result $ evalTricu Map.empty $ parseTricu value
    Export { hash = hashStr, exportNameOpt = legacyName, names = namesArg, outFile = outFilePath } -> do
      conn <- initContentStore
      let hashList = T.split (== ',') (T.pack hashStr)
      hashes <- mapM (\h -> do
        (resolvedHash, _) <- resolveExportTarget conn (T.unpack h)
        return resolvedHash) hashList
      -- Merge legacy -n and new -n (names); names wins when non-empty
      let allNames = if null namesArg
            then if null legacyName then [] else [legacyName]
            else namesArg
      let expNames = if null allNames
            then defaultExportNames (length hashes)
            else map T.pack allNames
      let exports = zip expNames hashes
      bundleData <- exportNamedBundle conn exports
      BL.writeFile outFilePath (BL.fromStrict bundleData)
      putStrLn $ "Exported bundle with " ++ show (length exports) ++ " export(s) to " ++ outFilePath
      close conn
    Import { inFile = importFile } -> do
      conn <- initContentStore
      bundleData <- BL.readFile importFile
      roots <- importBundle conn (BL.toStrict bundleData)
      putStrLn $ "Imported " ++ show (length roots) ++ " root(s):"
      mapM_ (\r -> putStrLn $ "  " ++ unpack r) roots
      close conn
    Compile { inputFile = compileInputFile, outFile = compileOutFile, names = namesArg } ->
      let exportNames = if null namesArg then [] else map T.pack namesArg
      in compileFile compileInputFile compileOutFile exportNames
    Serve { host = hostStr, port = portNum } -> do
      putStrLn $ "Starting Arboricx bundle server on " ++ hostStr ++ ":" ++ show portNum
      putStrLn $ "  GET /bundle/hash/:hash   -- primary endpoint"
      putStrLn $ "  GET /bundle/name/:name   -- convenience endpoint"
      putStrLn $ "  Content-Type: application/vnd.arboricx.bundle"
      runServer hostStr portNum

runTricu :: String -> String
runTricu = formatT TreeCalculus . runTricuT

runTricuT :: String -> T
runTricuT input =
  let asts     = parseTricu input
      finalEnv = evalTricu Map.empty asts
   in result finalEnv

runTricuEnv :: Env -> String -> String
runTricuEnv env = formatT TreeCalculus . runTricuTEnv env

runTricuTEnv :: Env -> String -> T
runTricuTEnv env input =
  let asts     = parseTricu input
      finalEnv = evalTricu env asts
   in result finalEnv

runTricuWithEnvT :: String -> (Env, T)
runTricuWithEnvT input =
  let asts     = parseTricu input
      finalEnv = evalTricu Map.empty asts
   in (finalEnv, result finalEnv)

runTricuWithEnv :: String -> (Env, String)
runTricuWithEnv input =
  let asts     = parseTricu input
      finalEnv = evalTricu Map.empty asts
      res      = result finalEnv
   in (finalEnv, formatT TreeCalculus res)

runTricuEnvWithEnvT :: Env -> String -> (Env, T)
runTricuEnvWithEnvT env input =
  let asts     = parseTricu input
      finalEnv = evalTricu env asts
   in (finalEnv, result finalEnv)

runTricuEnvWithEnv :: Env -> String -> (Env, String)
runTricuEnvWithEnv env input =
  let asts     = parseTricu input
      finalEnv = evalTricu env asts
      res      = result finalEnv
   in (finalEnv, formatT TreeCalculus res)

chooseExportName :: String -> String -> [Text] -> IO Text
chooseExportName explicitName input storedNames
  | not (null explicitName) = return $ T.pack explicitName
  | Just firstName <- firstNonEmpty storedNames = return firstName
  | otherwise = do
      hPutStrLn stderr $
        "No stored name found for export target " ++ input ++ "; using export name 'root'. "
        ++ "Use export -n NAME to preserve a semantic name."
      return "root"

firstNonEmpty :: [Text] -> Maybe Text
firstNonEmpty = go
  where
    go [] = Nothing
    go (x:xs)
      | T.null x = go xs
      | otherwise = Just x