{-# LANGUAGE CPP
            ,MultiParamTypeClasses
            ,TypeFamilies
            ,FlexibleInstances #-}
{-# OPTIONS -fno-warn-orphans #-}

module Data.ListLike.Text.Builder

where

#if !MIN_VERSION_base(4,8,0)
import           Control.Applicative
#endif
import           Control.DeepSeq (NFData(rnf))
import qualified Data.Text.Lazy.Builder as Builder
import           Data.ListLike.Base as LL
import           Data.ListLike.FoldableLL as LL
import           Data.ListLike.IO
import           Data.ListLike.String as LL
import           Data.ListLike.Text.TextLazy ()
--import           Data.String (IsString(fromString))
import           GHC.Exts (IsList(..))

instance FoldableLL Builder.Builder Char where
    foldl :: forall a. (a -> Char -> a) -> a -> Builder -> a
foldl a -> Char -> a
f a
r0 = forall full item a.
FoldableLL full item =>
(a -> item -> a) -> a -> full -> a
LL.foldl a -> Char -> a
f a
r0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Builder.toLazyText
    foldr :: forall b. (Char -> b -> b) -> b -> Builder -> b
foldr Char -> b -> b
f b
r0 = forall full item b.
FoldableLL full item =>
(item -> b -> b) -> b -> full -> b
LL.foldr Char -> b -> b
f b
r0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Builder.toLazyText

instance IsList Builder.Builder where
    type Item Builder.Builder = Char
    -- Can we do better?
    toList :: Builder -> [Item Builder]
toList = forall full item. ListLike full item => full -> [item]
LL.toList'
    fromList :: [Item Builder] -> Builder
fromList = forall full item. ListLike full item => [item] -> full
LL.fromList'

instance ListLike Builder.Builder Char where
    singleton :: Char -> Builder
singleton = Char -> Builder
Builder.singleton
    uncons :: Builder -> Maybe (Char, Builder)
uncons Builder
b = case forall full item. ListLike full item => full -> Maybe (item, full)
LL.uncons (Builder -> Text
Builder.toLazyText Builder
b) of
                 Maybe (Char, Text)
Nothing -> forall a. Maybe a
Nothing
                 Just (Char
c, Text
s) -> forall a. a -> Maybe a
Just (Char
c, Text -> Builder
Builder.fromLazyText Text
s)
    null :: Builder -> Bool
null = forall full item. ListLike full item => full -> Bool
LL.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Builder.toLazyText

instance ListLikeIO Builder.Builder Char where
    hGetLine :: Handle -> IO Builder
hGetLine Handle
h = Text -> Builder
Builder.fromLazyText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall full item. ListLikeIO full item => Handle -> IO full
hGetLine Handle
h
    hGetContents :: Handle -> IO Builder
hGetContents Handle
h = Text -> Builder
Builder.fromLazyText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall full item. ListLikeIO full item => Handle -> IO full
hGetContents Handle
h
    hGet :: Handle -> Int -> IO Builder
hGet Handle
h Int
n = Text -> Builder
Builder.fromLazyText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall full item. ListLikeIO full item => Handle -> Int -> IO full
hGet Handle
h Int
n
    hGetNonBlocking :: Handle -> Int -> IO Builder
hGetNonBlocking Handle
h Int
n = Text -> Builder
Builder.fromLazyText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall full item. ListLikeIO full item => Handle -> Int -> IO full
hGetNonBlocking Handle
h Int
n
    hPutStr :: Handle -> Builder -> IO ()
hPutStr Handle
h = forall full item. ListLikeIO full item => Handle -> full -> IO ()
hPutStr Handle
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Builder.toLazyText

instance StringLike Builder.Builder where
    toString :: Builder -> [Char]
toString = forall s. StringLike s => s -> [Char]
toString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Builder.toLazyText
    fromText :: StringLike Text => Text -> Builder
fromText = Text -> Builder
Builder.fromText
    fromLazyText :: StringLike Text => Text -> Builder
fromLazyText = Text -> Builder
Builder.fromLazyText

instance NFData Builder.Builder where
    rnf :: Builder -> ()
rnf = forall a. NFData a => a -> ()
rnf forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Builder.toLazyText