{-# LANGUAGE RequiredTypeArguments #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
module Gyehoek.QBE
  ( module QBE
  , render
  , fn
  , writeTo
  )
  where

import Gyehoek.QBE.Parse
import Language.QBE as QBE
import Data.String (IsString(fromString))
import Prettyprinter (Pretty(pretty), layoutPretty, defaultLayoutOptions)
import Data.Text (Text)
import Data.Data
import Prettyprinter.Render.Text (renderStrict)
import Text.Megaparsec
import Text.Megaparsec.Char
import Language.Haskell.TH qualified as TH
import Language.Haskell.TH.Quote
import Data.Kind (Type)
import qualified Data.Text.IO as TIO


writeTo :: FilePath -> Text -> IO ()
writeTo = TIO.writeFile

render :: Pretty a => a -> Text
render = renderStrict . layoutPretty defaultLayoutOptions . pretty



parseQuoteExp
  :: (TH.Quote m, MonadFail m, Data a) => P a -> String -> m TH.Exp
parseQuoteExp p s =
  case parse (space *> p <* space <* eof) "qq" (fromString s) of
    Left es -> fail . foldMap f . bundleErrors $ es
      where f e = parseErrorPretty e ++ "\n\n"
    Right x -> dataToExpQ (\_ -> Nothing) x

-- quoteExp :: TH.Quote m => forall (t :: Type) -> (Parser t) => String -> m TH.Exp
-- quoteExp t s = case parse (parser @t) "qq" (fromString s) of
--   Left es -> _
--   Right x -> dataToExpQ (\_ -> Nothing) x

makeQQ :: forall (t :: Type) -> Parser t => QuasiQuoter
makeQQ t = QuasiQuoter
  { quoteExp = parseQuoteExp (parser @t)
  , quotePat = _
  , quoteType = undefined
  , quoteDec = undefined
  }

fn :: QuasiQuoter
fn = makeQQ (type FuncDef)