{-# OPTIONS_GHC -Wno-overlapping-patterns #-}

module Mischief.ECS.World.Query.TH (q, s, g) where

import Control.Monad
import Control.Monad.IO.Class
import Data.Maybe
import Data.Text (Text)
import Data.Text qualified as T
import Data.Void
import Language.Haskell.TH
import Language.Haskell.TH qualified
import Language.Haskell.TH.Quote
import Language.Haskell.TH.Syntax
import Mischief.ECS.Collectable
import Mischief.ECS.Components
import Mischief.ECS.Components.Common hiding (Name)
import Mischief.ECS.Entities
import Mischief.ECS.Hidden
import Mischief.ECS.Log
import Mischief.ECS.Utils
import Mischief.ECS.World.Query
import Mischief.ECS.World.Query.QueryFilter
import Mischief.ECS.World.Query.Queryable hiding (Q)
import Mischief.ECS.World.Query.TH.QD
import Mischief.ECS.World.Query.TH.QF (Qf, pCheck, pQf, quoteQf)
import Text.Megaparsec (MonadParsec (eof), Parsec, choice, optional, parse, parseTest, runParserT, some, (<|>))
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer qualified as L

q :: QuasiQuoter
q :: QuasiQuoter
q =
  QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = \String
str -> do
        let x :: Either (ParseErrorBundle Text Void) Query
x = Parsec Void Text Query
-> String -> Text -> Either (ParseErrorBundle Text Void) Query
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parser ()
whitespace Parser () -> Parsec Void Text Query -> Parsec Void Text Query
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Query
pQuery Parsec Void Text Query -> Parser () -> Parsec Void Text Query
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"inline_input" (String -> Text
T.pack String
str)
        case Either (ParseErrorBundle Text Void) Query
x of
          Left ParseErrorBundle Text Void
f -> String -> Q Exp
forall a. HasCallStack => String -> a
error (ParseErrorBundle Text Void -> String
forall a. Show a => a -> String
show ParseErrorBundle Text Void
f)
          Right Query
x -> Query -> Q Exp
quoteQuery Query
x,
      quotePat :: String -> Q Pat
quotePat = String -> Q Pat
forall a. HasCallStack => a
undefined,
      quoteType :: String -> Q Type
quoteType = String -> Q Type
forall a. HasCallStack => a
undefined,
      quoteDec :: String -> Q [Dec]
quoteDec = String -> Q [Dec]
forall a. HasCallStack => a
undefined
    }

data Query = Query Qd (Maybe Qf) deriving (Int -> Query -> ShowS
[Query] -> ShowS
Query -> String
(Int -> Query -> ShowS)
-> (Query -> String) -> ([Query] -> ShowS) -> Show Query
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Query -> ShowS
showsPrec :: Int -> Query -> ShowS
$cshow :: Query -> String
show :: Query -> String
$cshowList :: [Query] -> ShowS
showList :: [Query] -> ShowS
Show)

pQuery :: Parser Query
pQuery :: Parsec Void Text Query
pQuery = do
  qd <- Parser Qd
pQd
  whitespace

  qf <- optional $ do
    void $ char '/'
    whitespace
    pQf

  pure $ Query qd qf

quoteQuery :: Query -> Q Exp
quoteQuery :: Query -> Q Exp
quoteQuery (Query Qd
qd Maybe Qf
Nothing) = Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'query) (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qd -> Q Exp
quoteQd Qd
qd
quoteQuery (Query Qd
qd (Just Qf
qf)) = do
  qd <- Qd -> Q Exp
quoteQd Qd
qd
  qf <- quoteQf qf
  return $ AppE (AppE (VarE 'query') qd) qf

s :: QuasiQuoter
s :: QuasiQuoter
s =
  QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = \String
str -> do
        let x :: Either (ParseErrorBundle Text Void) Query
x = Parsec Void Text Query
-> String -> Text -> Either (ParseErrorBundle Text Void) Query
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parser ()
whitespace Parser () -> Parsec Void Text Query -> Parsec Void Text Query
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Query
pQuery Parsec Void Text Query -> Parser () -> Parsec Void Text Query
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"inline_input" (String -> Text
T.pack String
str)
        case Either (ParseErrorBundle Text Void) Query
x of
          Left ParseErrorBundle Text Void
f -> String -> Q Exp
forall a. HasCallStack => String -> a
error (ParseErrorBundle Text Void -> String
forall a. Show a => a -> String
show ParseErrorBundle Text Void
f)
          Right Query
x -> Query -> Q Exp
quoteSingle Query
x,
      quotePat :: String -> Q Pat
quotePat = String -> Q Pat
forall a. HasCallStack => a
undefined,
      quoteType :: String -> Q Type
quoteType = String -> Q Type
forall a. HasCallStack => a
undefined,
      quoteDec :: String -> Q [Dec]
quoteDec = String -> Q [Dec]
forall a. HasCallStack => a
undefined
    }

quoteSingle :: Query -> Q Exp
quoteSingle :: Query -> Q Exp
quoteSingle (Query Qd
qd Maybe Qf
Nothing) = Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'single) (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qd -> Q Exp
quoteQd Qd
qd
quoteSingle (Query Qd
qd (Just Qf
qf)) = do
  qd <- Qd -> Q Exp
quoteQd Qd
qd
  qf <- quoteQf qf
  return $ AppE (AppE (VarE 'single') qd) qf

g :: QuasiQuoter
g :: QuasiQuoter
g =
  QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = \String
str -> do
        let x :: Either (ParseErrorBundle Text Void) Query
x = Parsec Void Text Query
-> String -> Text -> Either (ParseErrorBundle Text Void) Query
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parser ()
whitespace Parser () -> Parsec Void Text Query -> Parsec Void Text Query
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Query
pGet Parsec Void Text Query -> Parser () -> Parsec Void Text Query
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"inline_input" (String -> Text
T.pack String
str)
        case Either (ParseErrorBundle Text Void) Query
x of
          Left ParseErrorBundle Text Void
f -> String -> Q Exp
forall a. HasCallStack => String -> a
error (ParseErrorBundle Text Void -> String
forall a. Show a => a -> String
show ParseErrorBundle Text Void
f)
          Right Query
x -> Query -> Q Exp
quoteGet Query
x,
      quotePat :: String -> Q Pat
quotePat = String -> Q Pat
forall a. HasCallStack => a
undefined,
      quoteType :: String -> Q Type
quoteType = String -> Q Type
forall a. HasCallStack => a
undefined,
      quoteDec :: String -> Q [Dec]
quoteDec = String -> Q [Dec]
forall a. HasCallStack => a
undefined
    }

pGet :: Parser Query
pGet :: Parsec Void Text Query
pGet = do
  qd <- Parser Qd
pQd
  pure $ Query qd Nothing

quoteGet :: Query -> Q Exp
quoteGet :: Query -> Q Exp
quoteGet (Query Qd
qd Maybe Qf
_) = Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'get) (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qd -> Q Exp
quoteQd Qd
qd