module Ast.Parser.PreProcessor.Define where

import qualified Ast.Parser.Utils as PU
import qualified Control.Monad.IO.Class as IO
import qualified Data.Maybe as DM
import qualified System.Environment.Blank as EB
import qualified Text.Megaparsec as M
import qualified Text.Megaparsec.Char as MC

-- | Parses define directives.
-- Supports conditional logic based on environment variables.
-- Returns the processed string after applying defines.
parseDefines :: PU.Parser String
parseDefines :: Parser String
parseDefines = [Parser String] -> Parser String
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
M.choice [Parser String -> Parser String
forall a.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try Parser String
parseDefine, Parser String
parseSet]

-- | Parses a `?defined` directive.
-- The directive checks if an environment variable is defined.
-- If the variable exists, the `thenBlock` is returned.
-- Otherwise, the `elseBlock` (if present) is returned.
parseDefine :: PU.Parser String
parseDefine :: Parser String
parseDefine = do
  String
varName <- Tokens String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MC.string String
Tokens String
"?defined" ParsecT
  ParseErrorCustom String (StateT ParserState IO) (Tokens String)
-> Parser String -> Parser String
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT
  ParseErrorCustom String (StateT ParserState IO) (Tokens String)
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Tokens String)
-> Parser String
-> Parser String
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
M.between (Tokens String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MC.string String
Tokens String
"(") (Tokens String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MC.string String
Tokens String
")") (Maybe String
-> (Token String -> Bool)
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
M.takeWhileP Maybe String
forall a. Maybe a
Nothing (Token String -> Token String -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token String
')'))
  String
thenBlock <- Maybe String
-> (Token String -> Bool)
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
M.takeWhileP Maybe String
forall a. Maybe a
Nothing (Token String -> Token String -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token String
'?')
  Maybe String
elseBlock <- Parser String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
M.optional (Parser String
 -> ParsecT
      ParseErrorCustom String (StateT ParserState IO) (Maybe String))
-> Parser String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Maybe String)
forall a b. (a -> b) -> a -> b
$ Tokens String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MC.string String
Tokens String
"?else" ParsecT
  ParseErrorCustom String (StateT ParserState IO) (Tokens String)
-> Parser String -> Parser String
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe String
-> (Token String -> Bool)
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
M.takeWhileP Maybe String
forall a. Maybe a
Nothing (Token String -> Token String -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token String
'?')
  Tokens String
_ <- Tokens String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MC.string String
Tokens String
"?end"

  Maybe String
envVar <- IO (Maybe String)
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Maybe String)
forall a.
IO a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO (Maybe String)
 -> ParsecT
      ParseErrorCustom String (StateT ParserState IO) (Maybe String))
-> IO (Maybe String)
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
EB.getEnv String
varName
  case Maybe String
envVar of
    Just String
_ -> String -> Parser String
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return String
thenBlock
    Maybe String
_ -> String -> Parser String
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Parser String) -> String -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String
forall a. a -> Maybe a -> a
DM.fromMaybe String
"" Maybe String
elseBlock

-- | Parses a `?set` directive.
-- The directive sets an environment variable to an empty value.
parseSet :: PU.Parser String
parseSet :: Parser String
parseSet = do
  String
varName <- Tokens String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MC.string String
Tokens String
"?set" ParsecT
  ParseErrorCustom String (StateT ParserState IO) (Tokens String)
-> Parser String -> Parser String
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT
  ParseErrorCustom String (StateT ParserState IO) (Tokens String)
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Tokens String)
-> Parser String
-> Parser String
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
M.between (Tokens String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MC.string String
Tokens String
"(") (Tokens String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MC.string String
Tokens String
")") (Maybe String
-> (Token String -> Bool)
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
M.takeWhileP Maybe String
forall a. Maybe a
Nothing (Token String -> Token String -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token String
')'))
  ()
_ <- IO () -> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall a.
IO a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO ()
 -> ParsecT ParseErrorCustom String (StateT ParserState IO) ())
-> IO ()
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Bool -> IO ()
EB.setEnv String
varName String
"" Bool
False
  String -> Parser String
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""