{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}

{- | "Text.Printf" is a useful module, but due to the typeclass hacks it uses, it can
be hard to tell if the format string you wrote is well-formed or not.
This package provides a mechanism to create formatting functions at compile time.

Note that, to maintain consistency with other printf implementations, negative ints
that are printed as unsigned will \"underflow\". (Text.Printf does this too.)

>>> [s|%u|] (-1 :: Int32)
WAS "4294967295"
NOW Not in scope: type constructor or class `Int32'

Thus, any time you want to print a number using the unsigned, octal, or hex specifiers,
your input must be an instance of "Bounded".
-}
module Language.Haskell.Printf (
  s,
  t,
  p,
  hp,
) where

import Control.Monad.IO.Class
import Language.Haskell.Printf.Lib
import Language.Haskell.TH.Lib
import Language.Haskell.TH.Quote
import Language.Haskell.TH.Syntax
import System.IO (hPutStr)

{- | @
['s'|Hello, %s! (%d people greeted)|] :: ... -> 'String'
@

This formatter follows the guidelines listed
<http://www.cplusplus.com/reference/cstdio/printf/ here>, except for
@%n@ (store number of printed characters) for obvious
reasons.

@
%c     :: 'Char'
%s     :: 'String'
%q     :: 'Data.Text.Lazy.Text' -- lazy text
%Q     :: 'Data.Text.Text' -- strict text

-- datatypes with Show instances
%?     :: 'Show' a => a

-- signed integer types
%d, %i :: 'Integral' i => i

-- unsigned integer types
%u     :: ('Bounded' i, 'Integral' i) => i
%o     :: ('Bounded' i, 'Integral' i) => i
%x, %X :: ('Bounded' i, 'Integral' i) => i

-- floats
%a, %A :: 'RealFloat' f => f
%e, %E :: 'RealFloat' f => f
%f, %F :: 'RealFloat' f => f
%g, %G :: 'RealFloat' f => f

%p     :: 'Foreign.Ptr.Ptr' a
@
-}
s :: QuasiQuoter
s :: QuasiQuoter
s = (String -> ExpQ) -> QuasiQuoter
quoter forall a b. (a -> b) -> a -> b
$ \String
s' -> do
  ([Pat]
lhss, Exp
rhs) <- String -> OutputType -> Q ([Pat], Exp)
toSplices String
s' OutputType
OutputString
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Pat] -> Exp -> Exp
LamE [Pat]
lhss Exp
rhs

-- | Behaves identically to 's', but produces lazy 'Data.Text.Lazy.Text'.
t :: QuasiQuoter
t :: QuasiQuoter
t = (String -> ExpQ) -> QuasiQuoter
quoter forall a b. (a -> b) -> a -> b
$ \String
s' -> do
  ([Pat]
lhss, Exp
rhs) <- String -> OutputType -> Q ([Pat], Exp)
toSplices String
s' OutputType
OutputText
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Pat] -> Exp -> Exp
LamE [Pat]
lhss Exp
rhs

{- | Like 's', but prints the resulting string to @stdout@.

@
[p|Hello, %s! (%d people greeted)|] :: 'MonadIO' m => ... -> m ()
@
-}
p :: QuasiQuoter
p :: QuasiQuoter
p = (String -> ExpQ) -> QuasiQuoter
quoter forall a b. (a -> b) -> a -> b
$ \String
s' -> do
  ([Pat]
lhss, Exp
rhs) <- String -> OutputType -> Q ([Pat], Exp)
toSplices String
s' OutputType
OutputString
  forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
lamE (forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *) a. Applicative f => a -> f a
pure [Pat]
lhss) [|liftIO (putStr $(pure rhs))|]

{- | Like 'p', but takes as its first argument the 'System.IO.Handle' to print to.

@
[hp|Hello, %s! (%d people greeted)|] :: 'MonadIO' m => 'System.IO.Handle' -> ... -> m ()
@
-}
hp :: QuasiQuoter
hp :: QuasiQuoter
hp = (String -> ExpQ) -> QuasiQuoter
quoter forall a b. (a -> b) -> a -> b
$ \String
s' -> do
  ([Pat]
lhss, Exp
rhs) <- String -> OutputType -> Q ([Pat], Exp)
toSplices String
s' OutputType
OutputString
  Name
h <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"h"
  forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
lamE (forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
h forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *) a. Applicative f => a -> f a
pure [Pat]
lhss) [|liftIO (hPutStr $(varE h) $(pure rhs))|]

quoter :: (String -> ExpQ) -> QuasiQuoter
quoter :: (String -> ExpQ) -> QuasiQuoter
quoter String -> ExpQ
e =
  QuasiQuoter
    { quoteExp :: String -> ExpQ
quoteExp = String -> ExpQ
e
    , quotePat :: String -> Q Pat
quotePat = forall a. HasCallStack => String -> a
error String
"this quoter cannot be used in a pattern context"
    , quoteType :: String -> Q Type
quoteType = forall a. HasCallStack => String -> a
error String
"this quoter cannot be used in a type context"
    , quoteDec :: String -> Q [Dec]
quoteDec = forall a. HasCallStack => String -> a
error String
"this quoter cannot be used in a declaration context"
    }