content: -- |
  -- SPDX-License-Identifier: BSD-3-Clause
  --
  -- A quasiquoter for Swarm polytypes + untyped terms.
  module Swarm.Language.Parser.QQ (tyQ, astQ) where
  
  import Data.Generics
  import Language.Haskell.TH qualified as TH
  import Language.Haskell.TH.Quote
  import Swarm.Language.Parser.Core (runParserTH)
  import Swarm.Language.Parser.Lex (sc)
  import Swarm.Language.Parser.Term (parseTerm)
  import Swarm.Language.Parser.Type (parsePolytype)
  import Swarm.Language.Parser.Util (fully)
  import Swarm.Language.Syntax
  import Swarm.Util (liftText)
  import Witch (from)
  
  ------------------------------------------------------------
  -- Quasiquoters
  ------------------------------------------------------------
  
  -- | A quasiquoter for Swarm polytypes, so we can conveniently write them
  --   down using concrete syntax and have them parsed into abstract
  --   syntax at compile time.  This is used, for example, in writing down
  --   the concrete types of constants (see "Swarm.Language.Typecheck").
  tyQ :: QuasiQuoter
  tyQ =
    QuasiQuoter
      { quoteExp = quoteTypeExp
      , -- Using `error` is OK here since a quasiquoter will only ever run
        -- at compile time; hence it can only make compilation fail, not
        -- crash the game at runtime.
        quotePat = error "quotePat  not implemented for polytypes"
      , quoteType = error "quoteType not implemented for polytypes"
      , quoteDec = error "quoteDec  not implemented for polytypes"
      }
  
  quoteTypeExp :: String -> TH.ExpQ
  quoteTypeExp s = do
    loc <- TH.location
    parsed <- runParserTH loc (fully sc parsePolytype) s
    dataToExpQ (fmap liftText . cast) parsed
  
  astQ :: QuasiQuoter
  astQ =
    QuasiQuoter
      { quoteExp = quoteASTExp
      , quotePat = error "quotePat  not implemented for ASTs"
      , quoteType = error "quoteType not implemented for ASTs"
      , quoteDec = error "quoteDec  not implemented for ASTs"
      }
  
  quoteASTExp :: String -> TH.ExpQ
  quoteASTExp s = do
    loc <- TH.location
    parsed <- runParserTH loc (fully sc parseTerm) s
    dataToExpQ ((fmap liftText . cast) `extQ` antiASTExp) parsed
  
  antiASTExp :: Syntax -> Maybe TH.ExpQ
  antiASTExp (STerm (TAntiSyn v)) = Just $ TH.varE (TH.mkName (from v))
  antiASTExp _ = Nothing
  