-- | Yet another string interpolator
--
--  * Very simple, few dependencies.
--  * Based on 'Data.Text.Display.Display' instead of 'Show'.
--  * Depends on [ghc-hs-meta](https://hackage.haskell.org/package/ghc-hs-meta)
--    instead of [haskell-src-meta](https://hackage.haskell.org/package/haskell-src-meta)
--    for interpolating arbitrary expressions.
--    This results in faster compile times and fewer bugs.
module Yasi
  ( i,

    -- * Variants
    iFS,
    iS,
    iT,
    iTL,
  )
where

import Data.String (IsString (..))
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Language.Haskell.TH.Quote as TH
import qualified Language.Haskell.TH.Syntax as TH
import Yasi.Internal

-- $setup
-- >>> import Yasi
-- >>> import Data.Text (Text)
-- >>> import qualified Data.Text.Lazy

int :: (TH.Exp -> TH.Exp) -> TH.QuasiQuoter
int :: (Exp -> Exp) -> QuasiQuoter
int = Char -> (Exp -> Exp) -> QuasiQuoter
interpolator Char
'$'

intT :: TH.Name -> TH.QuasiQuoter
intT :: Name -> QuasiQuoter
intT = (Exp -> Exp) -> QuasiQuoter
int ((Exp -> Exp) -> QuasiQuoter)
-> (Name -> Exp -> Exp) -> Name -> QuasiQuoter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp -> Type -> Exp) -> Type -> Exp -> Exp
forall a b c. (a -> b -> c) -> b -> a -> c
flip Exp -> Type -> Exp
TH.SigE (Type -> Exp -> Exp) -> (Name -> Type) -> Name -> Exp -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Type
TH.ConT

-- | The main interpolator, intended to be used with
-- [@QuasiQuotes@](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/exts/template_haskell.html#extension-QuasiQuotes).
--
-- >>> :set -XQuasiQuotes
--
-- >>> (foo, bar) = ("yet another ", "interpolator")
-- >>> [i|${foo}string $bar|] :: String
-- "yet another string interpolator"
--
-- The result type can be 'String', strict 'T.Text' or lazy 'TL.Text'.
--
-- You can also use @${}@ to create a function interpolator (this "abstraction" feature is inspired by
-- [interpolate](https://hackage.haskell.org/package/interpolate)):
--
-- >>> [i|more ${}${} code${replicate 3 '!'}|] "point" "free" :: Text
-- "more pointfree code!!!"
i :: TH.QuasiQuoter
i :: QuasiQuoter
i = (Exp -> Exp) -> QuasiQuoter
int Exp -> Exp
forall a. a -> a
id

-- | Like 'i', but works with 'IsString'.
--
-- @['iFS'|...|] = 'fromString' ['i'|...|]@
--
-- >>> :t [iFS|hi|]
-- [iFS|hi|] :: Data.String.IsString a => a
iFS :: TH.QuasiQuoter
iFS :: QuasiQuoter
iFS = (Exp -> Exp) -> QuasiQuoter
int ((Exp -> Exp) -> QuasiQuoter) -> (Exp -> Exp) -> QuasiQuoter
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp
TH.AppE (Name -> Exp
TH.VarE 'fromString)

-- | Like 'i', but with the result type fixed to 'String'.
--
-- @['iS'|...|] = ['i'|...|] :: 'String'@
--
-- >>> :t [iS|hi|]
-- [iS|hi|] :: String
iS :: TH.QuasiQuoter
iS :: QuasiQuoter
iS = Name -> QuasiQuoter
intT ''String

-- | Like 'i', but with the result type fixed to strict 'T.Text'.
--
-- @['iT'|...|] = ['i'|...|] :: 'T.Text'@
--
-- >>> :t [iT|hi|]
-- [iT|hi|] :: Text
iT :: TH.QuasiQuoter
iT :: QuasiQuoter
iT = Name -> QuasiQuoter
intT ''T.Text

-- | Like 'i', but with the result type fixed to lazy 'TL.Text'.
--
-- @['iTL'|...|] = ['i'|...|] :: 'TL.Text'@
--
-- >>> :t [iTL|hi|]
-- [iTL|hi|] :: Data.Text.Lazy.Text
iTL :: TH.QuasiQuoter
iTL :: QuasiQuoter
iTL = Name -> QuasiQuoter
intT ''TL.Text