{-# OPTIONS -Wno-orphans           #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Strict                #-}
{-# LANGUAGE TypeFamilies          #-}

module Data.String.Interpolate.Conversion.TextSink
  ()
where

import qualified Data.ByteString         as B
import qualified Data.ByteString.Builder as LB
import qualified Data.ByteString.Lazy    as LB
import qualified Data.Text               as T
import qualified Data.Text.Lazy          as LT hiding ( singleton )
import qualified Data.Text.Lazy.Builder  as LT

import Data.String.Interpolate.Conversion.Classes
import Data.String.Interpolate.Conversion.Encoding ( bsToTextBuilder, lbsToTextBuilder )

#ifdef TEXT_BUILDER
#else
import qualified Data.Text.Lazy
#endif

--------------------
-- SINK DEFINITIONS
--------------------

#ifdef TEXT_BUILDER

instance InterpSink 'True T.Text where
  type Builder 'True T.Text = LT.Builder

  ofString _ = B . LT.fromString
  build _ (B l) (B r) = B $ l `mappend` r
  finalize _ = LT.toStrict . LT.toLazyText . unB

instance InterpSink 'True LT.Text where
  type Builder 'True LT.Text = LT.Builder

  ofString _ = B . LT.fromString
  build _ (B l) (B r) = B $ l `mappend` r
  finalize _ = LT.toLazyText . unB

#else

instance InterpSink 'True T.Text where
  type Builder 'True T.Text = T.Text

  ofString :: Proxy 'True -> String -> B Text (Builder 'True Text)
ofString Proxy 'True
_ = Text -> B Text Text
forall dst a. a -> B dst a
B (Text -> B Text Text) -> (String -> Text) -> String -> B Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
  build :: Proxy 'True
-> B Text (Builder 'True Text)
-> B Text (Builder 'True Text)
-> B Text (Builder 'True Text)
build Proxy 'True
_ (B Builder 'True Text
l) (B Builder 'True Text
r) = Text -> B Text Text
forall dst a. a -> B dst a
B (Text -> B Text Text) -> Text -> B Text Text
forall a b. (a -> b) -> a -> b
$ Text
Builder 'True Text
l Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
Builder 'True Text
r
  finalize :: Proxy 'True -> B Text (Builder 'True Text) -> Text
finalize Proxy 'True
_ = B Text (Builder 'True Text) -> Text
forall dst a. B dst a -> a
unB

instance InterpSink 'True LT.Text where
  type Builder 'True LT.Text = LT.Text

  ofString :: Proxy 'True -> String -> B Text (Builder 'True Text)
ofString Proxy 'True
_ = Text -> B Text Text
forall dst a. a -> B dst a
B (Text -> B Text Text) -> (String -> Text) -> String -> B Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
LT.pack
  build :: Proxy 'True
-> B Text (Builder 'True Text)
-> B Text (Builder 'True Text)
-> B Text (Builder 'True Text)
build Proxy 'True
_ (B Builder 'True Text
l) (B Builder 'True Text
r) = Text -> B Text Text
forall dst a. a -> B dst a
B (Text -> B Text Text) -> Text -> B Text Text
forall a b. (a -> b) -> a -> b
$ Text
Builder 'True Text
l Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
Builder 'True Text
r
  finalize :: Proxy 'True -> B Text (Builder 'True Text) -> Text
finalize Proxy 'True
_ = B Text (Builder 'True Text) -> Text
forall dst a. B dst a -> a
unB

#endif

instance InterpSink 'True LT.Builder where
  type Builder 'True LT.Builder = LT.Builder

  ofString :: Proxy 'True -> String -> B Builder (Builder 'True Builder)
ofString Proxy 'True
_ = Builder -> B Builder Builder
forall dst a. a -> B dst a
B (Builder -> B Builder Builder)
-> (String -> Builder) -> String -> B Builder Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
LT.fromString
  build :: Proxy 'True
-> B Builder (Builder 'True Builder)
-> B Builder (Builder 'True Builder)
-> B Builder (Builder 'True Builder)
build Proxy 'True
_ (B Builder 'True Builder
l) (B Builder 'True Builder
r) = Builder -> B Builder Builder
forall dst a. a -> B dst a
B (Builder -> B Builder Builder) -> Builder -> B Builder Builder
forall a b. (a -> b) -> a -> b
$ Builder
Builder 'True Builder
l Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
Builder 'True Builder
r
  finalize :: Proxy 'True -> B Builder (Builder 'True Builder) -> Builder
finalize Proxy 'True
_ = B Builder (Builder 'True Builder) -> Builder
forall dst a. B dst a -> a
unB

--------------------
-- INTERPOLATION INSTANCES
--------------------

#ifdef TEXT_BUILDER

instance {-# OVERLAPPABLE #-} Show src => Interpolatable 'True src T.Text where
  interpolate _ = B . LT.fromString . show
instance {-# OVERLAPS #-} Interpolatable 'True Char T.Text where
  interpolate _ = B . LT.singleton
instance {-# OVERLAPS #-} Interpolatable 'True String T.Text where
  interpolate _ = B . LT.fromString
instance {-# OVERLAPS #-} Interpolatable 'True T.Text T.Text where
  interpolate _ = B . LT.fromText
instance {-# OVERLAPS #-} Interpolatable 'True LT.Text T.Text where
  interpolate _ = B . LT.fromLazyText
instance {-# OVERLAPS #-} Interpolatable 'True LT.Builder T.Text where
  interpolate _ = B
instance {-# OVERLAPS #-} Interpolatable 'True B.ByteString T.Text where
  interpolate _ = B . bsToTextBuilder
instance {-# OVERLAPS #-} Interpolatable 'True LB.ByteString T.Text where
  interpolate _ = B . lbsToTextBuilder
instance {-# OVERLAPS #-} Interpolatable 'True LB.Builder T.Text where
  interpolate _ = B . lbsToTextBuilder . LB.toLazyByteString

instance {-# OVERLAPPABLE #-} Show src => Interpolatable 'True src LT.Text where
  interpolate _ = B . LT.fromString . show
instance {-# OVERLAPS #-} Interpolatable 'True Char LT.Text where
  interpolate _ = B . LT.singleton
instance {-# OVERLAPS #-} Interpolatable 'True String LT.Text where
  interpolate _ = B . LT.fromString
instance {-# OVERLAPS #-} Interpolatable 'True T.Text LT.Text where
  interpolate _ = B . LT.fromText
instance {-# OVERLAPS #-} Interpolatable 'True LT.Text LT.Text where
  interpolate _ = B . LT.fromLazyText
instance {-# OVERLAPS #-} Interpolatable 'True LT.Builder LT.Text where
  interpolate _ = B
instance {-# OVERLAPS #-} Interpolatable 'True B.ByteString LT.Text where
  interpolate _ = B . bsToTextBuilder
instance {-# OVERLAPS #-} Interpolatable 'True LB.ByteString LT.Text where
  interpolate _ = B . lbsToTextBuilder
instance {-# OVERLAPS #-} Interpolatable 'True LB.Builder LT.Text where
  interpolate _ = B . lbsToTextBuilder . LB.toLazyByteString

#else

instance {-# OVERLAPPABLE #-} Show src => Interpolatable 'True src T.Text where
  interpolate :: Proxy 'True -> src -> B Text (Builder 'True Text)
interpolate Proxy 'True
_ = Text -> B Text Text
forall dst a. a -> B dst a
B (Text -> B Text Text) -> (src -> Text) -> src -> B Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (src -> String) -> src -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. src -> String
forall a. Show a => a -> String
show
instance {-# OVERLAPS #-} Interpolatable 'True Char T.Text where
  interpolate :: Proxy 'True -> Char -> B Text (Builder 'True Text)
interpolate Proxy 'True
_ = Text -> B Text Text
forall dst a. a -> B dst a
B (Text -> B Text Text) -> (Char -> Text) -> Char -> B Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton
instance {-# OVERLAPS #-} Interpolatable 'True String T.Text where
  interpolate :: Proxy 'True -> String -> B Text (Builder 'True Text)
interpolate Proxy 'True
_ = Text -> B Text Text
forall dst a. a -> B dst a
B (Text -> B Text Text) -> (String -> Text) -> String -> B Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
instance {-# OVERLAPS #-} Interpolatable 'True T.Text T.Text where
  interpolate :: Proxy 'True -> Text -> B Text (Builder 'True Text)
interpolate Proxy 'True
_ = Text -> B Text (Builder 'True Text)
forall dst a. a -> B dst a
B
instance {-# OVERLAPS #-} Interpolatable 'True LT.Text T.Text where
  interpolate :: Proxy 'True -> Text -> B Text (Builder 'True Text)
interpolate Proxy 'True
_ = Text -> B Text Text
forall dst a. a -> B dst a
B (Text -> B Text Text) -> (Text -> Text) -> Text -> B Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.toStrict
instance {-# OVERLAPS #-} Interpolatable 'True LT.Builder T.Text where
  interpolate :: Proxy 'True -> Builder -> B Text (Builder 'True Text)
interpolate Proxy 'True
_ = Text -> B Text Text
forall dst a. a -> B dst a
B (Text -> B Text Text)
-> (Builder -> Text) -> Builder -> B Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LT.toLazyText
instance {-# OVERLAPS #-} Interpolatable 'True B.ByteString T.Text where
  interpolate :: Proxy 'True -> ByteString -> B Text (Builder 'True Text)
interpolate Proxy 'True
_ = Text -> B Text Text
forall dst a. a -> B dst a
B (Text -> B Text Text)
-> (ByteString -> Text) -> ByteString -> B Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.toStrict (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LT.toLazyText (Builder -> Text) -> (ByteString -> Builder) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
bsToTextBuilder
instance {-# OVERLAPS #-} Interpolatable 'True LB.ByteString T.Text where
  interpolate :: Proxy 'True -> ByteString -> B Text (Builder 'True Text)
interpolate Proxy 'True
_ = Text -> B Text Text
forall dst a. a -> B dst a
B (Text -> B Text Text)
-> (ByteString -> Text) -> ByteString -> B Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.toStrict (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LT.toLazyText (Builder -> Text) -> (ByteString -> Builder) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
lbsToTextBuilder
instance {-# OVERLAPS #-} Interpolatable 'True LB.Builder T.Text where
  interpolate :: Proxy 'True -> Builder -> B Text (Builder 'True Text)
interpolate Proxy 'True
_ = Text -> B Text Text
forall dst a. a -> B dst a
B (Text -> B Text Text)
-> (Builder -> Text) -> Builder -> B Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LT.toLazyText (Builder -> Text) -> (Builder -> Builder) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
lbsToTextBuilder (ByteString -> Builder)
-> (Builder -> ByteString) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
LB.toLazyByteString

instance {-# OVERLAPPABLE #-} Show src => Interpolatable 'True src LT.Text where
  interpolate :: Proxy 'True -> src -> B Text (Builder 'True Text)
interpolate Proxy 'True
_ = Text -> B Text Text
forall dst a. a -> B dst a
B (Text -> B Text Text) -> (src -> Text) -> src -> B Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
LT.pack (String -> Text) -> (src -> String) -> src -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. src -> String
forall a. Show a => a -> String
show
instance {-# OVERLAPS #-} Interpolatable 'True Char LT.Text where
  interpolate :: Proxy 'True -> Char -> B Text (Builder 'True Text)
interpolate Proxy 'True
_ = Text -> B Text Text
forall dst a. a -> B dst a
B (Text -> B Text Text) -> (Char -> Text) -> Char -> B Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
Data.Text.Lazy.singleton
instance {-# OVERLAPS #-} Interpolatable 'True String LT.Text where
  interpolate :: Proxy 'True -> String -> B Text (Builder 'True Text)
interpolate Proxy 'True
_ = Text -> B Text Text
forall dst a. a -> B dst a
B (Text -> B Text Text) -> (String -> Text) -> String -> B Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
LT.pack
instance {-# OVERLAPS #-} Interpolatable 'True T.Text LT.Text where
  interpolate :: Proxy 'True -> Text -> B Text (Builder 'True Text)
interpolate Proxy 'True
_ = Text -> B Text Text
forall dst a. a -> B dst a
B (Text -> B Text Text) -> (Text -> Text) -> Text -> B Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.fromStrict
instance {-# OVERLAPS #-} Interpolatable 'True LT.Text LT.Text where
  interpolate :: Proxy 'True -> Text -> B Text (Builder 'True Text)
interpolate Proxy 'True
_ = Text -> B Text (Builder 'True Text)
forall dst a. a -> B dst a
B
instance {-# OVERLAPS #-} Interpolatable 'True LT.Builder LT.Text where
  interpolate :: Proxy 'True -> Builder -> B Text (Builder 'True Text)
interpolate Proxy 'True
_ = Text -> B Text Text
forall dst a. a -> B dst a
B (Text -> B Text Text)
-> (Builder -> Text) -> Builder -> B Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LT.toLazyText
instance {-# OVERLAPS #-} Interpolatable 'True B.ByteString LT.Text where
  interpolate :: Proxy 'True -> ByteString -> B Text (Builder 'True Text)
interpolate Proxy 'True
_ = Text -> B Text Text
forall dst a. a -> B dst a
B (Text -> B Text Text)
-> (ByteString -> Text) -> ByteString -> B Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LT.toLazyText (Builder -> Text) -> (ByteString -> Builder) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
bsToTextBuilder
instance {-# OVERLAPS #-} Interpolatable 'True LB.ByteString LT.Text where
  interpolate :: Proxy 'True -> ByteString -> B Text (Builder 'True Text)
interpolate Proxy 'True
_ = Text -> B Text Text
forall dst a. a -> B dst a
B (Text -> B Text Text)
-> (ByteString -> Text) -> ByteString -> B Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LT.toLazyText (Builder -> Text) -> (ByteString -> Builder) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
lbsToTextBuilder
instance {-# OVERLAPS #-} Interpolatable 'True LB.Builder LT.Text where
  interpolate :: Proxy 'True -> Builder -> B Text (Builder 'True Text)
interpolate Proxy 'True
_ = Text -> B Text Text
forall dst a. a -> B dst a
B (Text -> B Text Text)
-> (Builder -> Text) -> Builder -> B Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LT.toLazyText (Builder -> Text) -> (Builder -> Builder) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
lbsToTextBuilder (ByteString -> Builder)
-> (Builder -> ByteString) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
LB.toLazyByteString

#endif

instance {-# OVERLAPPABLE #-} Show src => Interpolatable 'True src LT.Builder where
  interpolate :: Proxy 'True -> src -> B Builder (Builder 'True Builder)
interpolate Proxy 'True
_ = Builder -> B Builder Builder
forall dst a. a -> B dst a
B (Builder -> B Builder Builder)
-> (src -> Builder) -> src -> B Builder Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
LT.fromString (String -> Builder) -> (src -> String) -> src -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. src -> String
forall a. Show a => a -> String
show
instance {-# OVERLAPS #-} Interpolatable 'True Char LT.Builder where
  interpolate :: Proxy 'True -> Char -> B Builder (Builder 'True Builder)
interpolate Proxy 'True
_ = Builder -> B Builder Builder
forall dst a. a -> B dst a
B (Builder -> B Builder Builder)
-> (Char -> Builder) -> Char -> B Builder Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Builder
LT.singleton
instance {-# OVERLAPS #-} Interpolatable 'True String LT.Builder where
  interpolate :: Proxy 'True -> String -> B Builder (Builder 'True Builder)
interpolate Proxy 'True
_ = Builder -> B Builder Builder
forall dst a. a -> B dst a
B (Builder -> B Builder Builder)
-> (String -> Builder) -> String -> B Builder Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
LT.fromString
instance {-# OVERLAPS #-} Interpolatable 'True T.Text LT.Builder where
  interpolate :: Proxy 'True -> Text -> B Builder (Builder 'True Builder)
interpolate Proxy 'True
_ = Builder -> B Builder Builder
forall dst a. a -> B dst a
B (Builder -> B Builder Builder)
-> (Text -> Builder) -> Text -> B Builder Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
LT.fromText
instance {-# OVERLAPS #-} Interpolatable 'True LT.Text LT.Builder where
  interpolate :: Proxy 'True -> Text -> B Builder (Builder 'True Builder)
interpolate Proxy 'True
_ = Builder -> B Builder Builder
forall dst a. a -> B dst a
B (Builder -> B Builder Builder)
-> (Text -> Builder) -> Text -> B Builder Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
LT.fromLazyText
instance {-# OVERLAPS #-} Interpolatable 'True LT.Builder LT.Builder where
  interpolate :: Proxy 'True -> Builder -> B Builder (Builder 'True Builder)
interpolate Proxy 'True
_ = Builder -> B Builder (Builder 'True Builder)
forall dst a. a -> B dst a
B
instance {-# OVERLAPS #-} Interpolatable 'True B.ByteString LT.Builder where
  interpolate :: Proxy 'True -> ByteString -> B Builder (Builder 'True Builder)
interpolate Proxy 'True
_ = Builder -> B Builder Builder
forall dst a. a -> B dst a
B (Builder -> B Builder Builder)
-> (ByteString -> Builder) -> ByteString -> B Builder Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
bsToTextBuilder
instance {-# OVERLAPS #-} Interpolatable 'True LB.ByteString LT.Builder where
  interpolate :: Proxy 'True -> ByteString -> B Builder (Builder 'True Builder)
interpolate Proxy 'True
_ = Builder -> B Builder Builder
forall dst a. a -> B dst a
B (Builder -> B Builder Builder)
-> (ByteString -> Builder) -> ByteString -> B Builder Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
lbsToTextBuilder
instance {-# OVERLAPS #-} Interpolatable 'True LB.Builder LT.Builder where
  interpolate :: Proxy 'True -> Builder -> B Builder (Builder 'True Builder)
interpolate Proxy 'True
_ = Builder -> B Builder Builder
forall dst a. a -> B dst a
B (Builder -> B Builder Builder)
-> (Builder -> Builder) -> Builder -> B Builder Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
lbsToTextBuilder (ByteString -> Builder)
-> (Builder -> ByteString) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
LB.toLazyByteString