{-# LANGUAGE OverloadedStrings #-}

module MdBlocks.CLI where

import qualified Data.Aeson.Encode.Pretty as JSON
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Data.Text.IO as T
import qualified Data.Text as T
import System.Directory (doesFileExist)
import System.Exit (ExitCode(ExitFailure, ExitSuccess), die, exitWith)
import System.Process (createProcess, proc, waitForProcess)

import Options.Applicative

import MdBlocks.Address
import MdBlocks.Parser
import MdBlocks.Resolver
import MdBlocks.Types

data Command
  = List FilePath
  | Extract String
  | Run String [String]
  | ShowMeta String

runCLI :: IO ()
runCLI =
  execParser opts >>= run
  where
    opts =
      info
        (parser <**> helper)
        (fullDesc <> progDesc "Parse and extract Markdown blocks")

parser :: Parser Command
parser =
      listP
  <|> extractP
  <|> runP
  <|> showP

listP :: Parser Command
listP =
  List <$> strOption
    ( long "list"
    <> metavar "FILE"
    <> help "List blocks in a Markdown file"
    )

extractP :: Parser Command
extractP =
  Extract <$> strOption
    ( long "extract"
    <> metavar "FILE#ID"
    <> help "Extract a block by its address"
    )

runP :: Parser Command
runP =
  Run
    <$> strOption
      ( long "run"
      <> metavar "FILE#ID"
      <> help "Run a code block by its address"
      )
    <*> many (argument str (metavar "ARG..."))

showP :: Parser Command
showP =
  ShowMeta <$> strOption
    ( long "show"
    <> metavar "FILE#ID"
    <> help "Show block metadata"
    )

run :: Command -> IO ()

run (List fp) = do
  bs <- loadBlocks fp
  BL.putStrLn $
    JSON.encodePretty bs

run (Extract rawAddress) =
  case parseAddress rawAddress of
    Left err ->
      die ("mdblocks: " ++ err)

    Right address -> do
      isFile <- doesFileExist (addressFile address)

      if not isFile
        then
          die ("mdblocks: not a file: " ++ addressFile address)
        else do
          blocks <- loadBlocks (addressFile address)

          case resolveBlock address blocks of
            Left err ->
              die ("mdblocks: " ++ formatResolveError address err)

            Right block ->
              T.putStr (blockContent block)

run (Run rawAddress args) =
  case parseAddress rawAddress of
    Left err ->
      die ("mdblocks: " ++ err)

    Right address -> do
      isFile <- doesFileExist (addressFile address)

      if not isFile
        then
          die ("mdblocks: not a file: " ++ addressFile address)
        else do
          blocks <- loadBlocks (addressFile address)

          case resolveBlock address blocks of
            Left err ->
              die ("mdblocks: " ++ formatResolveError address err)

            Right block ->
              runBlock rawAddress block args

run (ShowMeta addr) =
  putStrLn ("show not implemented yet: " ++ addr)


loadBlocks :: FilePath -> IO [Block]
loadBlocks fp = do
  txt <- T.readFile fp
  pure (parseFile fp txt)


runBlock :: String -> Block -> [String] -> IO ()
runBlock rawAddress block args =
  case mdLanguage (blockMeta block) of
    Just "sh" ->
      runSh rawAddress block args

    Just language ->
      die $
        "mdblocks: no interpreter for language: "
          ++ T.unpack language

    Nothing ->
      die "mdblocks: block has no language"


runSh :: String -> Block -> [String] -> IO ()
runSh rawAddress block args = do
  (_, _, _, processHandle) <-
    createProcess $
      proc "/bin/sh"
        (["-c", T.unpack (blockContent block), rawAddress] ++ args)

  exitCode <- waitForProcess processHandle

  case exitCode of
    ExitSuccess ->
      pure ()

    ExitFailure code ->
      exitWith (ExitFailure code)