{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PackageImports #-}

import Control.RTree

import Data.Maybe (catMaybes, fromMaybe)
import Language.C qualified as C
import "pretty" Text.PrettyPrint qualified as P
import "transformers" Control.Monad.Trans.Maybe
import "typed-process" System.Process.Typed

main :: IO ()
main = do
  C.parseCFilePre "test/data/file2.c" >>= \case
    Right file -> do
      l <- runMaybeT (reduce' check (reduceC file))
      case l of
        Just l' -> output l'
        Nothing ->
          putStrLn "Failure"
    Left err ->
      print err
 where
  output l = do
    writeFile "test.c" (P.render (C.pretty l))

  check l = MaybeT do
    putStrLn "Outputting test"
    output l
    putStrLn "Running test"
    err <- runProcess (proc "clang" ["-O0", "test.c"])
    putStrLn $ "Done test" <> show err
    pure $ if err == ExitSuccess then Just () else Nothing

type Lab = C.Ident

reduceC :: C.CTranslUnit -> RTree' Lab C.CTranslUnit
reduceC (C.CTranslUnit es _) = do
  es' <- traverse rCExternalDeclaration es
  pure $ C.CTranslUnit (catMaybes es') C.undefNode

rCExternalDeclaration
  :: C.CExternalDeclaration C.NodeInfo
  -> RTree' Lab (Maybe (C.CExternalDeclaration C.NodeInfo))
rCExternalDeclaration e = case e of
  C.CFDefExt fun ->
    split
      (funName fun)
      (pure Nothing)
      (Just . C.CFDefExt <$> rCFunctionDef fun)
  _ -> pure Nothing <| pure (Just e)
 where
  funName (C.CFunDef _ (C.CDeclr x _ _ _ _) _ _ _) =
    x

rCFunctionDef :: C.CFunctionDef C.NodeInfo -> RTree' Lab (C.CFunctionDef C.NodeInfo)
rCFunctionDef (C.CFunDef spc dec cdecls smt _) = do
  smt' <- rCStatement smt
  pure $ C.CFunDef spc dec cdecls smt' C.undefNode

rCStatement :: C.CStatement C.NodeInfo -> RTree' Lab (C.CStatement C.NodeInfo)
rCStatement = \case
  C.CCompound is cbi _ -> do
    cbi' <- traverse rCCompoundBlockItem cbi
    pure $ C.CCompound is (catMaybes cbi') C.undefNode
  C.CExpr (Just e) _ -> do
    e' <- rCExpression e
    pure $ C.CExpr e' C.undefNode
  a -> pure a

rCExpression :: C.CExpression C.NodeInfo -> RTree' Lab (Maybe (C.CExpression C.NodeInfo))
rCExpression = \case
  C.CVar i _ ->
    splitOn
      i
      (pure Nothing)
      (pure . Just $ C.CVar i C.undefNode)
  C.CCall e es _ -> do
    me' <- rCExpression e
    case me' of
      Nothing -> pure Nothing
      Just e' -> do
        es' <-
          traverse
            ( fmap
                ( fromMaybe (C.CConst (C.CIntConst (C.cInteger 0) C.undefNode))
                )
                . rCExpression
            )
            es
        pure . Just $ C.CCall e' es' C.undefNode
  e -> pure Nothing <| pure (Just e)

rCCompoundBlockItem :: C.CCompoundBlockItem C.NodeInfo -> RTree' Lab (Maybe (C.CCompoundBlockItem C.NodeInfo))
rCCompoundBlockItem a = pure Nothing <| pure (Just a)