{-# LANGUAGE TemplateHaskell #-}

module Inferno.Utils.QQ.Common where

import Data.Text (Text)
import qualified Data.Text as Text
import Inferno.Parse.Error (prettyError)
import Language.Haskell.TH.Syntax
  ( Exp (AppE, VarE),
    Lift (lift),
    Loc (loc_filename, loc_start),
    Q,
    location,
  )
import Text.Megaparsec (ParseError, ShowErrorComponent, SourcePos (..), mkPos, unPos)

location' :: Q SourcePos
location' :: Q SourcePos
location' = Loc -> SourcePos
aux forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Loc
location
  where
    aux :: Loc -> SourcePos
    aux :: Loc -> SourcePos
aux Loc
loc = let (Int
l, Int
c) = (Loc -> (Int, Int)
loc_start Loc
loc) in String -> Pos -> Pos -> SourcePos
SourcePos (Loc -> String
loc_filename Loc
loc) (Int -> Pos
mkPos Int
l) (Int -> Pos
mkPos Int
c)

-- fix for https://stackoverflow.com/questions/38143464/cant-find-inerface-file-declaration-for-variable
liftText :: Text -> Q Exp
liftText :: Text -> Q Exp
liftText Text
txt = Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'Text.pack) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
lift (Text -> String
Text.unpack Text
txt)

mkParseErrorStr :: ShowErrorComponent e => (ParseError Text e, SourcePos) -> String
mkParseErrorStr :: forall e.
ShowErrorComponent e =>
(ParseError Text e, SourcePos) -> String
mkParseErrorStr (ParseError Text e
err, SourcePos {String
Pos
sourceColumn :: SourcePos -> Pos
sourceLine :: SourcePos -> Pos
sourceName :: SourcePos -> String
sourceColumn :: Pos
sourceLine :: Pos
sourceName :: String
..}) =
  String
"Error at line "
    forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Pos -> Int
unPos Pos
sourceLine)
    forall a. Semigroup a => a -> a -> a
<> String
" column "
    forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Pos -> Int
unPos Pos
sourceColumn)
    forall a. Semigroup a => a -> a -> a
<> String
"\n        "
    forall a. Semigroup a => a -> a -> a
<> (Text -> String
Text.unpack forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> Text -> Text
Text.replace Text
"\n" Text
"\n        " forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. ShowErrorComponent e => ParseError Text e -> String
prettyError ParseError Text e
err)