module Main where

import Control.Monad (forM_)
import Control.Monad.Identity (Identity)
import Control.Monad.Writer
import Data.Aeson (Value (Null), encode)
import qualified Data.ByteString.Lazy.Char8 as BL
import Data.Data (cast)
import qualified Data.Text as Text
import qualified Data.Text.IO
import Data.Typeable
import GHC.IO.Exception (ExitCode (ExitFailure, ExitSuccess))
import Language.Fiddle.Ast
import Language.Fiddle.Compiler
import Language.Fiddle.Compiler.ConsistencyCheck
import Language.Fiddle.Compiler.Expansion
import Language.Fiddle.Compiler.ImportResolution
import Language.Fiddle.Compiler.Stage0
import Language.Fiddle.GenericTree (GenericSyntaxTree (..), ToGenericSyntaxTree (toGenericSyntaxTree), alterGenericSyntaxTree)
import qualified Language.Fiddle.Parser
import qualified Language.Fiddle.Tokenizer
import qualified System.Environment as System
import System.Exit (exitWith)

phases res =
  importResolutionPhase res >>> expansionPhase >>> consistencyCheckPhase

main :: IO ()
main = do
  argv <- System.getArgs
  let opts = ImportResolutionOptions ["."]

  case argv of
    [filePath] -> do
      text <- Data.Text.IO.readFile filePath
      let maybeParsedAst = compile_ $ toStage0 filePath text >>= toStage1

      case maybeParsedAst of
        (priorDiags, Just ast) -> do
          ((priorDiags ++) -> diags, ma) <-
            execCompilationPipeline (phases opts) ast
          ec <-
            case ma of
              Just ast -> do
                putStrLn $
                  BL.unpack $
                    encode $
                      alterGenericSyntaxTree cleanupIdentifiers $
                        toGenericSyntaxTree $
                          fmap
                            (const (Nothing :: Maybe Value))
                            ast
                return ExitSuccess
              Nothing -> do
                putStrLn "\x1b[1;31mCompilation Failed\x1b[0m"
                return (ExitFailure 1)

          forM_ diags printDiagnostic
          exitWith ec
        (diags, _) -> do
          putStrLn "\x1b[1;31mParsing Failed\x1b[0m"
          forM_ diags printDiagnostic
          exitWith (ExitFailure 1)
    _ -> do
      putStrLn "Wrong Args"
      exitWith (ExitFailure 2)

cleanupIdentifiers :: GenericSyntaxTree Identity a -> Maybe (GenericSyntaxTree Identity a)
cleanupIdentifiers (SyntaxTreeObject _ _ _ tr)
  | (Just (Identifier n _)) <- castT tr =
      Just $ SyntaxTreeValue (Text.unpack n)
  where
    castT ::
      (Typeable t, Typeable f, Typeable a, Typeable t') =>
      t f a ->
      Maybe (t' f a)
    castT = cast
cleanupIdentifiers _ = Nothing