module Formatting.Internal 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 {runFormat :: (Builder -> r) -> a}
instance Monoid (Format r (a -> r)) where
mappend m n =
Format (\k a ->
runFormat m (\b1 -> runFormat n (\b2 -> k (b1 <> b2)) a) a)
mempty = Format (\k _ -> k mempty)
instance (a ~ r) => IsString (Format r a) where
fromString = now . fromString
instance Category Format where
id = now mempty
f . g =
f `bind`
\a ->
g `bind`
\b -> now (a `mappend` b)
(%) :: Format r a -> Format r' r -> Format r' a
(%) = (.)
infixr 9 %
(%.) :: Format r (Builder -> r') -> Format r' a -> Format r a
(%.) (Format a) (Format b) = Format (b . a)
infixr 8 %.
now :: Builder -> Format r r
now a = Format ($ a)
bind :: Format r a -> (Builder -> Format r' r) -> Format r' a
m `bind` f = Format $ \k -> runFormat m (\a -> runFormat (f a) k)
later :: (a -> Builder) -> Format r (a -> r)
later f = Format (. f)
format :: Format Text a -> a
format m = runFormat m T.toLazyText
sformat :: Format S.Text a -> a
sformat m = runFormat m (T.toStrict . T.toLazyText)
bprint :: Format Builder a -> a
bprint m = runFormat m id
fprint :: Format (IO ()) a -> a
fprint m = runFormat m (T.putStr . T.toLazyText)
hprint :: Handle -> Format (IO ()) a -> a
hprint h m = runFormat m (T.hPutStr h . T.toLazyText)
formatToString :: Format [Char] a -> a
formatToString m = runFormat m (TL.unpack . TLB.toLazyText)