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 (coloredFormat, compile_, printDiagnostic)
import Language.Fiddle.Compiler.Stage0
import Language.Fiddle.Compiler.Stage1
import Language.Fiddle.Compiler.Stage2
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)

main :: IO ()
main = do
  argv <- System.getArgs

  case argv of
    [filePath] -> do
      text <- Data.Text.IO.readFile filePath
      let (diags, ma) = compile_ $ toStage3 =<< toStage2 =<< toStage1 =<< toStage0 filePath text
      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
    _ -> 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