{-# LANGUAGE GADTs #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}


module Fmt.Internal.Core where

#if __GLASGOW_HASKELL__ < 804
import           Data.Monoid ((<>))
#endif
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.IO as TL
import qualified Data.Text.Lazy.Encoding as TL
import           Data.Text.Lazy.Builder hiding (fromString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Builder as BB
import           Formatting.Buildable (Buildable(..))


----------------------------------------------------------------------------
-- Class
----------------------------------------------------------------------------

class FromBuilder a where
  -- | Convert a 'Builder' to something else.
  fromBuilder :: Builder -> a

instance FromBuilder Builder where
  fromBuilder :: Builder -> Builder
fromBuilder = Builder -> Builder
forall a. a -> a
id
  {-# INLINE fromBuilder #-}

instance (a ~ Char) => FromBuilder [a] where
  fromBuilder :: Builder -> [a]
fromBuilder = Text -> String
TL.unpack (Text -> String) -> (Builder -> Text) -> Builder -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText
  {-# INLINE fromBuilder #-}

instance FromBuilder T.Text where
  fromBuilder :: Builder -> Text
fromBuilder = Text -> Text
TL.toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText
  {-# INLINE fromBuilder #-}

instance FromBuilder TL.Text where
  fromBuilder :: Builder -> Text
fromBuilder = Builder -> Text
toLazyText
  {-# INLINE fromBuilder #-}

instance FromBuilder BS.ByteString where
  fromBuilder :: Builder -> ByteString
fromBuilder = Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> (Builder -> Text) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText
  {-# INLINE fromBuilder #-}

instance FromBuilder BSL.ByteString where
  fromBuilder :: Builder -> ByteString
fromBuilder = Text -> ByteString
TL.encodeUtf8 (Text -> ByteString) -> (Builder -> Text) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText
  {-# INLINE fromBuilder #-}

instance FromBuilder BB.Builder where
  fromBuilder :: Builder -> Builder
fromBuilder = Text -> Builder
TL.encodeUtf8Builder (Text -> Builder) -> (Builder -> Text) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText
  {-# INLINE fromBuilder #-}

instance (a ~ ()) => FromBuilder (IO a) where
  fromBuilder :: Builder -> IO a
fromBuilder = Text -> IO ()
TL.putStr (Text -> IO ()) -> (Builder -> Text) -> Builder -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText
  {-# INLINE fromBuilder #-}

----------------------------------------------------------------------------
-- Operators
----------------------------------------------------------------------------

-- | Concatenate, then convert.
(+|) :: (FromBuilder b) => Builder -> Builder -> b
+| :: Builder -> Builder -> b
(+|) Builder
str Builder
rest = Builder -> b
forall a. FromBuilder a => Builder -> a
fromBuilder (Builder
str Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
rest)

-- | 'build' and concatenate, then convert.
(|+) :: (Buildable a, FromBuilder b) => a -> Builder -> b
|+ :: a -> Builder -> b
(|+) a
a Builder
rest = Builder -> b
forall a. FromBuilder a => Builder -> a
fromBuilder (a -> Builder
forall p. Buildable p => p -> Builder
build a
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
rest)

infixr 1 +|
infixr 1 |+

-- | Concatenate, then convert.
(+||) :: (FromBuilder b) => Builder -> Builder -> b
+|| :: Builder -> Builder -> b
(+||) Builder
str Builder
rest = Builder
str Builder -> Builder -> b
forall b. FromBuilder b => Builder -> Builder -> b
+| Builder
rest
{-# INLINE (+||) #-}

-- | 'show' and concatenate, then convert.
(||+) :: (Show a, FromBuilder b) => a -> Builder -> b
||+ :: a -> Builder -> b
(||+) a
a Builder
rest = a -> String
forall a. Show a => a -> String
show a
a String -> Builder -> b
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
rest
{-# INLINE (||+) #-}

infixr 1 +||
infixr 1 ||+

(|++|) :: (Buildable a, FromBuilder b) => a -> Builder -> b
|++| :: a -> Builder -> b
(|++|) a
a Builder
rest = Builder -> b
forall a. FromBuilder a => Builder -> a
fromBuilder (a -> Builder
forall p. Buildable p => p -> Builder
build a
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
rest)
{-# INLINE (|++|) #-}

(||++||) :: (Show a, FromBuilder b) => a -> Builder -> b
||++|| :: a -> Builder -> b
(||++||) a
a Builder
rest = a -> String
forall a. Show a => a -> String
show a
a String -> Builder -> b
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
rest
{-# INLINE (||++||) #-}

(||++|) :: (Buildable a, FromBuilder b) => a -> Builder -> b
||++| :: a -> Builder -> b
(||++|) a
a Builder
rest = a
a a -> Builder -> b
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|++| Builder
rest
{-# INLINE (||++|) #-}

(|++||) :: (Show a, FromBuilder b) => a -> Builder -> b
|++|| :: a -> Builder -> b
(|++||) a
a Builder
rest = a
a a -> Builder -> b
forall a b. (Show a, FromBuilder b) => a -> Builder -> b
||++|| Builder
rest
{-# INLINE (|++||) #-}

infixr 1 |++|
infixr 1 ||++||
infixr 1 ||++|
infixr 1 |++||

----------------------------------------------------------------------------
-- Functions
----------------------------------------------------------------------------

{- | 'fmt' converts things to 'String', 'T.Text', 'BS.ByteString' or 'Builder'.

Most of the time you won't need it, as strings produced with ('+|') and
('|+') can already be used as 'String', 'T.Text', etc. However, combinators
like 'listF' can only produce 'Builder' (for better type inference), and you
need to use 'fmt' on them.

Also, 'fmt' can do printing:

>>> fmt "Hello world!\n"
Hello world!
-}
fmt :: FromBuilder b => Builder -> b
fmt :: Builder -> b
fmt = Builder -> b
forall a. FromBuilder a => Builder -> a
fromBuilder
{-# INLINE fmt #-}

{- | Like 'fmt', but appends a newline.
-}
fmtLn :: FromBuilder b => Builder -> b
fmtLn :: Builder -> b
fmtLn = Builder -> b
forall a. FromBuilder a => Builder -> a
fromBuilder (Builder -> b) -> (Builder -> Builder) -> Builder -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n")
{-# INLINE fmtLn #-}

{- | 'pretty' shows a value using its 'Buildable' instance.
-}
pretty :: (Buildable a, FromBuilder b) => a -> b
pretty :: a -> b
pretty = Builder -> b
forall a. FromBuilder a => Builder -> a
fmt (Builder -> b) -> (a -> Builder) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
forall p. Buildable p => p -> Builder
build
{-# INLINE pretty #-}

{- | Like 'pretty', but appends a newline.
-}
prettyLn :: (Buildable a, FromBuilder b) => a -> b
prettyLn :: a -> b
prettyLn = Builder -> b
forall a. FromBuilder a => Builder -> a
fmtLn (Builder -> b) -> (a -> Builder) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
forall p. Buildable p => p -> Builder
build
{-# INLINE prettyLn #-}