module CustomInterpolation.Config where

import Data.Default.Class (Default (..))
import Language.Haskell.TH (Exp, Q, appE)

{- $setup
=== __ __
>>> import CustomInterpolation -- doctest setup, ignore this
-}

-- | Rules for interpolating a string.
data InterpolationConfig a = InterpolationConfig
  { -- | The 'Interpolator's that handle interpolated expressions.
    InterpolationConfig a -> [Interpolator a]
handlers :: [Interpolator a],
    -- | Used for complex 'Interpolator's that return additional values. Reduces these accumulated values to a single @'Q' 'Exp'@.
    InterpolationConfig a -> ([a], Q Exp) -> Q Exp
finalize :: ([a], Q Exp) -> Q Exp,
    -- | Handle backslash-escaped characters (can be used to add special characters like \n).
    InterpolationConfig a -> Char -> Char
escape :: Char -> Char
  }

{- | Type-restricted simple version of 'defaultConfig'.
Use this if you just want to substitute interpolated segments with a string expression.
-}
simpleConfig :: InterpolationConfig ()
simpleConfig :: InterpolationConfig ()
simpleConfig = InterpolationConfig ()
forall a. InterpolationConfig a
defaultConfig

{- | Default 'InterpolationConfig'.
Has no 'handlers', 'finalize' ignores any extra values returned when interpolating and 'escape' does nothing.
-}
defaultConfig :: InterpolationConfig a
defaultConfig :: InterpolationConfig a
defaultConfig = InterpolationConfig :: forall a.
[Interpolator a]
-> (([a], Q Exp) -> Q Exp)
-> (Char -> Char)
-> InterpolationConfig a
InterpolationConfig {handlers :: [Interpolator a]
handlers = [], finalize :: ([a], Q Exp) -> Q Exp
finalize = ([a], Q Exp) -> Q Exp
forall a b. (a, b) -> b
snd, escape :: Char -> Char
escape = Char -> Char
forall a. a -> a
id}

-- | @'def' = 'defaultConfig'@
instance Default (InterpolationConfig a) where
  def :: InterpolationConfig a
def = InterpolationConfig a
forall a. InterpolationConfig a
defaultConfig

data Interpolator a = Interpolator
  { -- | InterpolationConfig prefix, a prefix of e.g. @"$"@ will lead to anything inside @${expr}@ being interpolated (assuming 'curlyBrackets').
    Interpolator a -> Prefix
prefix :: Prefix,
    -- | Transforms the interpolated string segment into a string expression and some value of type @a@ to accumulate.
    Interpolator a -> Q Exp -> (a, Q Exp)
handler :: Q Exp -> (a, Q Exp),
    -- | The brackets to use for the interpolation syntax.
    Interpolator a -> Brackets
brackets :: Brackets
  }

type Prefix = String

data Brackets = Brackets {Brackets -> Char
opening :: Char, Brackets -> Char
closing :: Char} deriving (Int -> Brackets -> ShowS
[Brackets] -> ShowS
Brackets -> Prefix
(Int -> Brackets -> ShowS)
-> (Brackets -> Prefix) -> ([Brackets] -> ShowS) -> Show Brackets
forall a.
(Int -> a -> ShowS) -> (a -> Prefix) -> ([a] -> ShowS) -> Show a
showList :: [Brackets] -> ShowS
$cshowList :: [Brackets] -> ShowS
show :: Brackets -> Prefix
$cshow :: Brackets -> Prefix
showsPrec :: Int -> Brackets -> ShowS
$cshowsPrec :: Int -> Brackets -> ShowS
Show)

-- | @{}@
curlyBrackets :: Brackets
curlyBrackets :: Brackets
curlyBrackets = Char -> Char -> Brackets
Brackets Char
'{' Char
'}'

-- | @()@
roundBrackets :: Brackets
roundBrackets :: Brackets
roundBrackets = Char -> Char -> Brackets
Brackets Char
'(' Char
')'

-- | @[]@
squareBrackets :: Brackets
squareBrackets :: Brackets
squareBrackets = Char -> Char -> Brackets
Brackets Char
'[' Char
']'

-- | @<>@
angleBrackets :: Brackets
angleBrackets :: Brackets
angleBrackets = Char -> Char -> Brackets
Brackets Char
'<' Char
'>'

{- | Default 'Interpolator'.
Inserts the interpolated expression as is and uses 'curlyBrackets' with no 'prefix'.
-}
simpleInterpolator :: Interpolator ()
simpleInterpolator :: Interpolator ()
simpleInterpolator = Interpolator :: forall a.
Prefix -> (Q Exp -> (a, Q Exp)) -> Brackets -> Interpolator a
Interpolator {prefix :: Prefix
prefix = Prefix
"", handler :: Q Exp -> ((), Q Exp)
handler = Q Exp -> ((), Q Exp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure, brackets :: Brackets
brackets = Brackets
curlyBrackets}

{- | Create an 'Interpolator' that applies a quoted function to the interpolated expression. Uses 'curlyBrackets' and no 'prefix'.

==== __Example__
>>> $(interpolate (simpleConfig {handlers = [applyInterpolator [|show . (^ 2)|]]}) "two squared equals {2}")
"two squared equals 4"
-}
applyInterpolator :: Monoid a => Q Exp -> Interpolator a
applyInterpolator :: Q Exp -> Interpolator a
applyInterpolator Q Exp
funExp = Interpolator ()
simpleInterpolator {handler :: Q Exp -> (a, Q Exp)
handler = Q Exp -> (a, Q Exp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Q Exp -> (a, Q Exp)) -> (Q Exp -> Q Exp) -> Q Exp -> (a, Q Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q Exp -> Q Exp -> Q Exp
appE Q Exp
funExp}