{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
module Fmt.Internal.Template where
import Data.CallStack
import Data.String (IsString(..))
import Data.Text (Text, splitOn)
import Data.Text.Lazy.Builder hiding (fromString)
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup
#endif
import Formatting.Buildable (Buildable(..))
import Fmt.Internal.Core (FromBuilder(..))
format :: (HasCallStack, FormatType r) => Format -> r
format :: forall r. (HasCallStack, FormatType r) => Format -> r
format Format
f = forall r. FormatType r => Format -> [Builder] -> r
format' Format
f []
{-# INLINE format #-}
formatLn :: (HasCallStack, FormatType r) => Format -> r
formatLn :: forall r. (HasCallStack, FormatType r) => Format -> r
formatLn Format
f = forall r. FormatType r => Format -> [Builder] -> r
format' (Format
f forall a. Semigroup a => a -> a -> a
<> Format
"\n") []
{-# INLINE formatLn #-}
newtype Format = Format { Format -> Text
fromFormat :: Text }
deriving (Format -> Format -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c== :: Format -> Format -> Bool
Eq, Eq Format
Format -> Format -> Bool
Format -> Format -> Ordering
Format -> Format -> Format
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Format -> Format -> Format
$cmin :: Format -> Format -> Format
max :: Format -> Format -> Format
$cmax :: Format -> Format -> Format
>= :: Format -> Format -> Bool
$c>= :: Format -> Format -> Bool
> :: Format -> Format -> Bool
$c> :: Format -> Format -> Bool
<= :: Format -> Format -> Bool
$c<= :: Format -> Format -> Bool
< :: Format -> Format -> Bool
$c< :: Format -> Format -> Bool
compare :: Format -> Format -> Ordering
$ccompare :: Format -> Format -> Ordering
Ord, Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Format] -> ShowS
$cshowList :: [Format] -> ShowS
show :: Format -> String
$cshow :: Format -> String
showsPrec :: Int -> Format -> ShowS
$cshowsPrec :: Int -> Format -> ShowS
Show)
instance Semigroup Format where
Format Text
a <> :: Format -> Format -> Format
<> Format Text
b = Text -> Format
Format (Text
a forall a. Semigroup a => a -> a -> a
<> Text
b)
instance Monoid Format where
mempty :: Format
mempty = Text -> Format
Format forall a. Monoid a => a
mempty
#if !(MIN_VERSION_base(4,11,0))
mappend = (<>)
#endif
instance IsString Format where
fromString :: String -> Format
fromString = Text -> Format
Format forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString
renderFormat :: Format -> [Builder] -> Builder
renderFormat :: Format -> [Builder] -> Builder
renderFormat Format
fmt [Builder]
ps = [Builder] -> [Builder] -> Builder
zipParams (Format -> [Builder]
crack Format
fmt) [Builder]
ps
{-# INLINE renderFormat #-}
zipParams :: [Builder] -> [Builder] -> Builder
zipParams :: [Builder] -> [Builder] -> Builder
zipParams [Builder]
fragments [Builder]
params = forall {a}. Semigroup a => [a] -> [a] -> a
go [Builder]
fragments [Builder]
params
where go :: [a] -> [a] -> a
go (a
f:[a]
fs) (a
y:[a]
ys) = a
f forall a. Semigroup a => a -> a -> a
<> a
y forall a. Semigroup a => a -> a -> a
<> [a] -> [a] -> a
go [a]
fs [a]
ys
go [a
f] [] = a
f
go [a]
_ [a]
_ = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Fmt.format: there were " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Builder]
fragments forall a. Num a => a -> a -> a
- Int
1) forall a. Semigroup a => a -> a -> a
<>
String
" sites, but " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Builder]
params) forall a. Semigroup a => a -> a -> a
<> String
" parameters"
crack :: Format -> [Builder]
crack :: Format -> [Builder]
crack = forall a b. (a -> b) -> [a] -> [b]
map Text -> Builder
fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
splitOn Text
"{}" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Text
fromFormat
class FormatType r where
format' :: Format -> [Builder] -> r
instance (Buildable a, FormatType r) => FormatType (a -> r) where
format' :: Format -> [Builder] -> a -> r
format' Format
f [Builder]
xs = \a
x -> forall r. FormatType r => Format -> [Builder] -> r
format' Format
f (forall p. Buildable p => p -> Builder
build a
x forall a. a -> [a] -> [a]
: [Builder]
xs)
instance {-# OVERLAPPABLE #-} FromBuilder r => FormatType r where
format' :: Format -> [Builder] -> r
format' Format
f [Builder]
xs = forall a. FromBuilder a => Builder -> a
fromBuilder forall a b. (a -> b) -> a -> b
$ Format -> [Builder] -> Builder
renderFormat Format
f (forall a. [a] -> [a]
reverse [Builder]
xs)