{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE CPP #-}

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE IncoherentInstances #-}
{-# LANGUAGE FlexibleInstances #-}

module Text.InterpolatedString.QM.Internal.Parsers.Helpers
  ( unQX
  , clearIndentAtStart
  , clearIndentAtSOF
  , clearIndentTillEOF
  , clearFirstQXXLineBreak
  , clearLastQXXLineBreak
  , makeExpr
  ) where

import "base" GHC.Exts (IsString (fromString))
import "haskell-src-meta" Language.Haskell.Meta.Parse (parseExp)
import qualified "template-haskell" Language.Haskell.TH as TH

#if !MIN_VERSION_base(4,8,0)
import "base" Data.Monoid (mempty, mappend)
#endif

-- local imports

import Text.InterpolatedString.QM.ShowQ.Class (ShowQ (..))

import Text.InterpolatedString.QM.Internal.Parsers.Types ( Parser
                                                         , StringPart (..)
                                                         )


class    QQ a string                     where toQQ :: a -> string
instance IsString s => QQ s s            where toQQ :: s -> s
toQQ = s -> s
forall a. a -> a
id
instance (ShowQ a, IsString s) => QQ a s where toQQ :: a -> s
toQQ = String -> s
forall a. IsString a => String -> a
fromString (String -> s) -> (a -> String) -> a -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. ShowQ a => a -> String
showQ


-- Parser for interpolation block
unQX :: Parser -> Parser
unQX :: Parser -> Parser
unQX Parser
_ String
a String
""            = [String -> StringPart
Literal (String -> String
forall a. [a] -> [a]
reverse String
a)] -- Error, block isn't closed
unQX Parser
f String
a (Char
'\\':Char
'}':String
xs) = Parser -> Parser
unQX Parser
f (Char
'}'Char -> String -> String
forall a. a -> [a] -> [a]
:String
a) String
xs
unQX Parser
f String
a (Char
'}':String
xs)      = String -> StringPart
AntiQuote (String -> String
forall a. [a] -> [a]
reverse String
a) StringPart -> [StringPart] -> [StringPart]
forall a. a -> [a] -> [a]
: Parser
f String
"" String
xs
unQX Parser
f String
a (Char
x:String
xs)        = Parser -> Parser
unQX Parser
f (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
a) String
xs


clearIndentAtSOF :: String -> Maybe String
clearIndentAtSOF :: String -> Maybe String
clearIndentAtSOF String
"" = Maybe String
forall a. Maybe a
Nothing
clearIndentAtSOF (Char
'\r':Char
'\n':String
xs) = String -> Maybe String
clearIndentAtSOF (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Char
'\n' Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
clearIndentAtSOF s :: String
s@(Char
x:String
xs) | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
&& Bool
hasChanges = String -> Maybe String
forall a. a -> Maybe a
Just String
processed
                          | Bool
otherwise               = Maybe String
forall a. Maybe a
Nothing

  where processed :: String
processed  = Char
'\n' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
cutOff String
xs
        hasChanges :: Bool
hasChanges = String
processed String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
s

        cutOff :: String -> String
cutOff String
"" = String
""
        cutOff z :: String
z@(Char
y:String
ys) | Char
y Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"\t " = String -> String
cutOff String
ys
                        | Bool
otherwise      = String
z


clearIndentTillEOF :: String -> Maybe String
clearIndentTillEOF :: String -> Maybe String
clearIndentTillEOF String
"" = Maybe String
forall a. Maybe a
Nothing
clearIndentTillEOF s :: String
s@(Char
x:String
_) | Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"\t " = String -> Maybe String
cutOff String
s
                           | Bool
otherwise      = Maybe String
forall a. Maybe a
Nothing

  where cutOff :: String -> Maybe String
cutOff String
"" = String -> Maybe String
forall a. a -> Maybe a
Just String
""
        cutOff (Char
'\r':Char
'\n':String
xs) = String -> Maybe String
cutOff (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Char
'\n' Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
        cutOff z :: String
z@(Char
'\n':String
_) = String -> Maybe String
forall a. a -> Maybe a
Just String
z
        cutOff (Char
y:String
ys) | Char
y Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"\t " = String -> Maybe String
cutOff String
ys
                      | Bool
otherwise      = Maybe String
forall a. Maybe a
Nothing


clearLastQXXLineBreak :: String -> Bool
-- Cannot really be empty (matched in `parseQMB`)
clearLastQXXLineBreak :: String -> Bool
clearLastQXXLineBreak String
"" = Bool
False
clearLastQXXLineBreak (Char
'\r':Char
'\n':String
xs) = String -> Bool
clearLastQXXLineBreak (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ Char
'\n' Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
clearLastQXXLineBreak (Char
x:String
xs) | Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"\t \n" = String -> Bool
f String
xs
                             | Bool
otherwise        = Bool
False

  where f :: String -> Bool
f String
"" = Bool
True
        f (Char
'\r':Char
'\n':String
ys) = String -> Bool
f (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ Char
'\n' Char -> String -> String
forall a. a -> [a] -> [a]
: String
ys
        f (Char
y:String
ys) | Char
y Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"\t \n" = String -> Bool
f String
ys
                 | Bool
otherwise        = Bool
False


clearFirstQXXLineBreak :: String -> String
clearFirstQXXLineBreak :: String -> String
clearFirstQXXLineBreak String
"" = String
""
clearFirstQXXLineBreak (Char
'\r':Char
'\n':String
xs) = String -> String
clearFirstQXXLineBreak (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Char
'\n' Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
clearFirstQXXLineBreak s :: String
s@(Char
x:String
xs) | Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"\t \n" = String -> String
cutOff String
xs
                                | Bool
otherwise        = String
s

  where cutOff :: String -> String
cutOff String
"" = String
""
        cutOff (Char
'\r':Char
'\n':String
ys) = String -> String
cutOff (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Char
'\n' Char -> String -> String
forall a. a -> [a] -> [a]
: String
ys
        cutOff c :: String
c@(Char
y:String
ys) | Char
y Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"\t \n" = String -> String
cutOff String
ys
                        | Bool
otherwise        = String
c


clearIndentAtStart :: String -> String
clearIndentAtStart :: String -> String
clearIndentAtStart String
"" = String
""
clearIndentAtStart s :: String
s@(Char
x:String
xs) | Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"\t " = String -> String
clearIndentAtStart String
xs
                            | Bool
otherwise      = String
s


makeExpr :: [StringPart] -> TH.ExpQ
makeExpr :: [StringPart] -> ExpQ
makeExpr [] = [| mempty |]
makeExpr (Literal String
a : [StringPart]
xs) =
  ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE [| mappend (fromString a) |]    (ExpQ -> ExpQ) -> ExpQ -> ExpQ
forall a b. (a -> b) -> a -> b
$ [StringPart] -> ExpQ
makeExpr [StringPart]
xs
makeExpr (AntiQuote String
a : [StringPart]
xs) =
  ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
TH.appE [| mappend (toQQ $(reify a)) |] (ExpQ -> ExpQ) -> ExpQ -> ExpQ
forall a b. (a -> b) -> a -> b
$ [StringPart] -> ExpQ
makeExpr [StringPart]
xs
  where reify :: String -> TH.Q TH.Exp
        reify :: String -> ExpQ
reify String
s = case String -> Either String Exp
parseExp String
s of
#if MIN_VERSION_template_haskell(2,8,0)
                       Left  String
err  -> String -> Q ()
TH.reportError String
err Q () -> ExpQ -> ExpQ
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [| mempty |]
#else
                       Left  err  -> TH.report True err >> [| mempty |]
#endif
                       Right Exp
expr -> Exp -> ExpQ
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
expr