{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleInstances #-}
module Formatting.Internal
( Format(..)
, (%)
, (%.)
, now
, bind
, mapf
, later
, format
, sformat
, bprint
, bformat
, fprint
, fprintLn
, hprint
, hprintLn
, formatToString
) where
import Control.Category (Category(..))
import Data.Monoid
import Data.String
import qualified Data.Text as S (Text)
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy as TL
import Data.Text.Lazy.Builder (Builder)
import qualified Data.Text.Lazy.Builder as T
import qualified Data.Text.Lazy.Builder as TLB
import qualified Data.Text.Lazy.IO as T
import Prelude hiding ((.),id)
import System.IO
newtype Format r a =
Format {forall r a. Format r a -> (Builder -> r) -> a
runFormat :: (Builder -> r) -> a}
instance Functor (Format r) where
fmap :: forall a b. (a -> b) -> Format r a -> Format r b
fmap a -> b
f (Format (Builder -> r) -> a
k) = forall r a. ((Builder -> r) -> a) -> Format r a
Format (a -> b
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Builder -> r) -> a
k)
instance Semigroup (Format r (a -> r)) where
Format r (a -> r)
m <> :: Format r (a -> r) -> Format r (a -> r) -> Format r (a -> r)
<> Format r (a -> r)
n =
forall r a. ((Builder -> r) -> a) -> Format r a
Format (\Builder -> r
k a
a ->
forall r a. Format r a -> (Builder -> r) -> a
runFormat Format r (a -> r)
m (\Builder
b1 -> forall r a. Format r a -> (Builder -> r) -> a
runFormat Format r (a -> r)
n (\Builder
b2 -> Builder -> r
k (Builder
b1 forall a. Semigroup a => a -> a -> a
<> Builder
b2)) a
a) a
a)
instance Monoid (Format r (a -> r)) where
mempty :: Format r (a -> r)
mempty = forall r a. ((Builder -> r) -> a) -> Format r a
Format (\Builder -> r
k a
_ -> Builder -> r
k forall a. Monoid a => a
mempty)
instance (a ~ r) => IsString (Format r a) where
fromString :: String -> Format r a
fromString = forall r. Builder -> Format r r
now forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. IsString a => String -> a
fromString
instance Category Format where
id :: forall a. Format a a
id = forall r. Builder -> Format r r
now forall a. Monoid a => a
mempty
Format b c
f . :: forall b c a. Format b c -> Format a b -> Format a c
. Format a b
g =
Format b c
f forall r a r'.
Format r a -> (Builder -> Format r' r) -> Format r' a
`bind`
\Builder
a ->
Format a b
g forall r a r'.
Format r a -> (Builder -> Format r' r) -> Format r' a
`bind`
\Builder
b -> forall r. Builder -> Format r r
now (Builder
a forall a. Monoid a => a -> a -> a
`mappend` Builder
b)
(%) :: Format r a -> Format r' r -> Format r' a
% :: forall b c a. Format b c -> Format a b -> Format a c
(%) = forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(.)
infixr 9 %
(%.) :: Format r (Builder -> r') -> Format r' a -> Format r a
%. :: forall r r' a.
Format r (Builder -> r') -> Format r' a -> Format r a
(%.) (Format (Builder -> r) -> Builder -> r'
a) (Format (Builder -> r') -> a
b) = forall r a. ((Builder -> r) -> a) -> Format r a
Format ((Builder -> r') -> a
b forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Builder -> r) -> Builder -> r'
a)
infixr 8 %.
now :: Builder -> Format r r
now :: forall r. Builder -> Format r r
now Builder
a = forall r a. ((Builder -> r) -> a) -> Format r a
Format (forall a b. (a -> b) -> a -> b
$ Builder
a)
bind :: Format r a -> (Builder -> Format r' r) -> Format r' a
Format r a
m bind :: forall r a r'.
Format r a -> (Builder -> Format r' r) -> Format r' a
`bind` Builder -> Format r' r
f = forall r a. ((Builder -> r) -> a) -> Format r a
Format forall a b. (a -> b) -> a -> b
$ \Builder -> r'
k -> forall r a. Format r a -> (Builder -> r) -> a
runFormat Format r a
m (\Builder
a -> forall r a. Format r a -> (Builder -> r) -> a
runFormat (Builder -> Format r' r
f Builder
a) Builder -> r'
k)
mapf :: (a -> b) -> Format r (b -> t) -> Format r (a -> t)
mapf :: forall a b r t. (a -> b) -> Format r (b -> t) -> Format r (a -> t)
mapf a -> b
f Format r (b -> t)
m = forall r a. ((Builder -> r) -> a) -> Format r a
Format (\Builder -> r
k -> forall r a. Format r a -> (Builder -> r) -> a
runFormat Format r (b -> t)
m Builder -> r
k forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
f)
later :: (a -> Builder) -> Format r (a -> r)
later :: forall a r. (a -> Builder) -> Format r (a -> r)
later a -> Builder
f = forall r a. ((Builder -> r) -> a) -> Format r a
Format (forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Builder
f)
format :: Format Text a -> a
format :: forall a. Format Text a -> a
format Format Text a
m = forall r a. Format r a -> (Builder -> r) -> a
runFormat Format Text a
m Builder -> Text
T.toLazyText
sformat :: Format S.Text a -> a
sformat :: forall a. Format Text a -> a
sformat Format Text a
m = forall r a. Format r a -> (Builder -> r) -> a
runFormat Format Text a
m (Text -> Text
T.toStrict forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Builder -> Text
T.toLazyText)
bprint :: Format Builder a -> a
bprint :: forall a. Format Builder a -> a
bprint Format Builder a
m = forall r a. Format r a -> (Builder -> r) -> a
runFormat Format Builder a
m forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
bformat :: Format Builder a -> a
bformat :: forall a. Format Builder a -> a
bformat Format Builder a
m = forall r a. Format r a -> (Builder -> r) -> a
runFormat Format Builder a
m forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
fprint :: Format (IO ()) a -> a
fprint :: forall a. Format (IO ()) a -> a
fprint Format (IO ()) a
m = forall r a. Format r a -> (Builder -> r) -> a
runFormat Format (IO ()) a
m (Text -> IO ()
T.putStr forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Builder -> Text
T.toLazyText)
fprintLn :: Format (IO ()) a -> a
fprintLn :: forall a. Format (IO ()) a -> a
fprintLn Format (IO ()) a
m = forall r a. Format r a -> (Builder -> r) -> a
runFormat Format (IO ()) a
m (Text -> IO ()
T.putStrLn forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Builder -> Text
T.toLazyText)
hprint :: Handle -> Format (IO ()) a -> a
hprint :: forall a. Handle -> Format (IO ()) a -> a
hprint Handle
h Format (IO ()) a
m = forall r a. Format r a -> (Builder -> r) -> a
runFormat Format (IO ()) a
m (Handle -> Text -> IO ()
T.hPutStr Handle
h forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Builder -> Text
T.toLazyText)
hprintLn :: Handle -> Format (IO ()) a -> a
hprintLn :: forall a. Handle -> Format (IO ()) a -> a
hprintLn Handle
h Format (IO ()) a
m = forall r a. Format r a -> (Builder -> r) -> a
runFormat Format (IO ()) a
m (Handle -> Text -> IO ()
T.hPutStrLn Handle
h forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Builder -> Text
T.toLazyText)
formatToString :: Format String a -> a
formatToString :: forall a. Format String a -> a
formatToString Format String a
m = forall r a. Format r a -> (Builder -> r) -> a
runFormat Format String a
m (Text -> String
TL.unpack forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Builder -> Text
TLB.toLazyText)