    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE OverloadedStrings #-}
    module Say
        ( -- * Stdout
          say
        , sayString
        , sayShow
          -- * Stderr
        , sayErr
        , sayErrString
        , sayErrShow
          -- * Handle
        , hSay
        , hSayString
        , hSayShow
        ) where

    import           Control.Monad                   (join, void)
    import           Control.Monad.IO.Class          (MonadIO, liftIO)
    import qualified Data.ByteString                 as S
    import qualified Data.ByteString.Builder         as BB
    import qualified Data.ByteString.Builder.Prim    as BBP
    import qualified Data.ByteString.Char8           as S8
    import           Data.IORef
    import           Data.Monoid                     (mappend)
    import           Data.Text                       (Text, pack)
    import qualified Data.Text.Encoding              as TE
    import           Data.Text.Internal.Fusion       (stream)
    import           Data.Text.Internal.Fusion.Types (Step (..), Stream (..))
    import           GHC.IO.Buffer                   (Buffer (..), BufferState (..),
                                                      CharBufElem, CharBuffer,
                                                      RawCharBuffer, emptyBuffer,
                                                      newCharBuffer, writeCharBuf)
    import           GHC.IO.Encoding.Types           (textEncodingName)
    import           GHC.IO.Handle.Internals         (wantWritableHandle)
    import           GHC.IO.Handle.Text              (commitBuffer')
    import           GHC.IO.Handle.Types             (BufferList (..),
                                                      Handle__ (..))
    import           System.IO                       (Handle, Newline (..), stderr,
                                                      stdout)

    -- | Send a 'Text' to standard output, appending a newline, and chunking the
    -- data. By default, the chunk size is 2048 characters, so any messages below
    -- that size will be sent as one contiguous unit. If larger messages are used,
    -- it is possible for interleaving with other threads to occur.
    --
    -- @since 0.1.0.0
    say :: MonadIO m => Text -> m ()
    say :: forall (m :: * -> *). MonadIO m => Text -> m ()
    say = Handle -> Text -> m ()
    forall (m :: * -> *). MonadIO m => Handle -> Text -> m ()
    hSay Handle
    stdout
    {-# INLINE say #-}

    -- | Same as 'say', but operates on a 'String'. Note that this will
    -- force the entire @String@ into memory at once, and will fail for
    -- infinite @String@s.
    --
    -- @since 0.1.0.0
    sayString :: MonadIO m => String -> m ()
    sayString :: forall (m :: * -> *). MonadIO m => String -> m ()
    sayString = Handle -> String -> m ()
    forall (m :: * -> *). MonadIO m => Handle -> String -> m ()
    hSayString Handle
    stdout
    {-# INLINE sayString #-}

    -- | Same as 'say', but for instances of 'Show'.
    --
    -- If your @Show@ instance generates infinite output, this will fail. However,
    -- an infinite result for @show@ would generally be considered an invalid
    -- instance anyway.
    --
    -- @since 0.1.0.0
    sayShow :: (MonadIO m, Show a) => a -> m ()
    sayShow :: forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
    sayShow = Handle -> a -> m ()
    forall (m :: * -> *) a. (MonadIO m, Show a) => Handle -> a -> m ()
    hSayShow Handle
    stdout
    {-# INLINE sayShow #-}

    -- | Same as 'say', but data is sent to standard error.
    --
    -- @since 0.1.0.0
    sayErr :: MonadIO m => Text -> m ()
    sayErr :: forall (m :: * -> *). MonadIO m => Text -> m ()
    sayErr = Handle -> Text -> m ()
    forall (m :: * -> *). MonadIO m => Handle -> Text -> m ()
    hSay Handle
    stderr
    {-# INLINE sayErr #-}

    -- | Same as 'sayString', but data is sent to standard error.
    --
    -- @since 0.1.0.0
    sayErrString :: MonadIO m => String -> m ()
    sayErrString :: forall (m :: * -> *). MonadIO m => String -> m ()
    sayErrString = Handle -> String -> m ()
    forall (m :: * -> *). MonadIO m => Handle -> String -> m ()
    hSayString Handle
    stderr
    {-# INLINE sayErrString #-}

    -- | Same as 'sayShow', but data is sent to standard error.
    --
    -- @since 0.1.0.0
    sayErrShow :: (MonadIO m, Show a) => a -> m ()
    sayErrShow :: forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
    sayErrShow = Handle -> a -> m ()
    forall (m :: * -> *) a. (MonadIO m, Show a) => Handle -> a -> m ()
    hSayShow Handle
    stderr
    {-# INLINE sayErrShow #-}

    -- | Same as 'say', but data is sent to the provided 'Handle'.
    --
    -- @since 0.1.0.0
    hSay :: MonadIO m => Handle -> Text -> m ()
    hSay :: forall (m :: * -> *). MonadIO m => Handle -> Text -> m ()
    hSay Handle
    h Text
    msg =
      IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ IO (IO ()) -> IO ()
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (IO (IO ()) -> IO ()) -> IO (IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> Handle -> (Handle__ -> IO (IO ())) -> IO (IO ())
    forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
    wantWritableHandle String
    "hSay" Handle
    h ((Handle__ -> IO (IO ())) -> IO (IO ()))
    -> (Handle__ -> IO (IO ())) -> IO (IO ())
    forall a b. (a -> b) -> a -> b
    $ \Handle__
    h_ -> do
        let nl :: Newline
    nl = Handle__ -> Newline
    haOutputNL Handle__
    h_
        if (TextEncoding -> String) -> Maybe TextEncoding -> Maybe String
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap TextEncoding -> String
    textEncodingName (Handle__ -> Maybe TextEncoding
    haCodec Handle__
    h_) Maybe String -> Maybe String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "UTF-8"
          then IO () -> IO (IO ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IO () -> IO (IO ())) -> IO () -> IO (IO ())
    forall a b. (a -> b) -> a -> b
    $ case Newline
    nl of
                          Newline
    LF   -> IO ()
    viaUtf8Raw
                          Newline
    CRLF -> IO ()
    viaUtf8CRLF
          else do
            CharBuffer
    buf <- Handle__ -> IO CharBuffer
    getSpareBuffer Handle__
    h_
            IO () -> IO (IO ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IO () -> IO (IO ())) -> IO () -> IO (IO ())
    forall a b. (a -> b) -> a -> b
    $
              case Newline
    nl of
                Newline
    CRLF -> CharBuffer -> Stream Char -> IO ()
    writeBlocksCRLF CharBuffer
    buf Stream Char
    str
                Newline
    LF   -> CharBuffer -> Stream Char -> IO ()
    writeBlocksRaw  CharBuffer
    buf Stream Char
    str
            -- Note that the release called below will return the buffer to the
            -- list of spares
      where
        str :: Stream Char
    str = Text -> Stream Char
    stream Text
    msg

        viaUtf8Raw :: IO ()
        viaUtf8Raw :: IO ()
    viaUtf8Raw = Handle -> Builder -> IO ()
    BB.hPutBuilder Handle
    h (Text -> Builder
    TE.encodeUtf8Builder Text
    msg Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Word8 -> Builder
    BB.word8 Word8
    10)

        viaUtf8CRLF :: IO ()
        viaUtf8CRLF :: IO ()
    viaUtf8CRLF =
            Handle -> Builder -> IO ()
    BB.hPutBuilder Handle
    h (Builder
    builder Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` FixedPrim Any -> Any -> Builder
    forall a. FixedPrim a -> a -> Builder
    BBP.primFixed FixedPrim Any
    forall {b}. FixedPrim b
    crlf (String -> Any
    forall a. HasCallStack => String -> a
    error String
    "viaUtf8CRLF"))
          where
            builder :: Builder
    builder = BoundedPrim Word8 -> Text -> Builder
    TE.encodeUtf8BuilderEscaped BoundedPrim Word8
    escapeLF Text
    msg
            escapeLF :: BoundedPrim Word8
    escapeLF =
                (Word8 -> Bool)
    -> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
    forall a.
    (a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
    BBP.condB
                    (Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    10)
                    (FixedPrim Word8 -> BoundedPrim Word8
    forall a. FixedPrim a -> BoundedPrim a
    BBP.liftFixedToBounded FixedPrim Word8
    forall {b}. FixedPrim b
    crlf)
                    (FixedPrim Word8 -> BoundedPrim Word8
    forall a. FixedPrim a -> BoundedPrim a
    BBP.liftFixedToBounded FixedPrim Word8
    BBP.word8)

            crlf :: FixedPrim b
    crlf =
                (Word8, Word8) -> FixedPrim b
    forall {b}. (Word8, Word8) -> FixedPrim b
    fixed2 (Word8
    13, Word8
    10)
              where
                fixed2 :: (Word8, Word8) -> FixedPrim b
    fixed2 (Word8, Word8)
    x = (Word8, Word8) -> b -> (Word8, Word8)
    forall a b. a -> b -> a
    const (Word8, Word8)
    x (b -> (Word8, Word8)) -> FixedPrim (Word8, Word8) -> FixedPrim b
    forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
    BBP.>$< FixedPrim Word8
    BBP.word8 FixedPrim Word8 -> FixedPrim Word8 -> FixedPrim (Word8, Word8)
    forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
    BBP.>*< FixedPrim Word8
    BBP.word8

        getSpareBuffer :: Handle__ -> IO CharBuffer
        getSpareBuffer :: Handle__ -> IO CharBuffer
    getSpareBuffer Handle__{haCharBuffer :: Handle__ -> IORef CharBuffer
    haCharBuffer=IORef CharBuffer
    ref, haBuffers :: Handle__ -> IORef (BufferList Char)
    haBuffers=IORef (BufferList Char)
    spare_ref} = do
            -- Despite appearances, IORef operations here are not a race
            -- condition, since we're already inside the MVar lock
            CharBuffer
    buf  <- IORef CharBuffer -> IO CharBuffer
    forall a. IORef a -> IO a
    readIORef IORef CharBuffer
    ref
            BufferList Char
    bufs <- IORef (BufferList Char) -> IO (BufferList Char)
    forall a. IORef a -> IO a
    readIORef IORef (BufferList Char)
    spare_ref
            case BufferList Char
    bufs of
                BufferListCons RawBuffer Char
    b BufferList Char
    rest -> do
                    IORef (BufferList Char) -> BufferList Char -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (BufferList Char)
    spare_ref BufferList Char
    rest
                    CharBuffer -> IO CharBuffer
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RawBuffer Char -> Int -> BufferState -> CharBuffer
    forall e. RawBuffer e -> Int -> BufferState -> Buffer e
    emptyBuffer RawBuffer Char
    b (CharBuffer -> Int
    forall e. Buffer e -> Int
    bufSize CharBuffer
    buf) BufferState
    WriteBuffer)
                BufferList Char
    BufferListNil -> do
                    CharBuffer
    new_buf <- Int -> BufferState -> IO CharBuffer
    newCharBuffer (CharBuffer -> Int
    forall e. Buffer e -> Int
    bufSize CharBuffer
    buf) BufferState
    WriteBuffer
                    CharBuffer -> IO CharBuffer
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CharBuffer
    new_buf

        writeBlocksRaw :: Buffer CharBufElem -> Stream Char -> IO ()
        writeBlocksRaw :: CharBuffer -> Stream Char -> IO ()
    writeBlocksRaw CharBuffer
    buf0 (Stream s -> Step s Char
    next0 s
    s0 Size
    _len) =
            s -> CharBuffer -> IO ()
    outer s
    s0 CharBuffer
    buf0
          where
            outer :: s -> CharBuffer -> IO ()
    outer s
    s1 Buffer{bufRaw :: forall e. Buffer e -> RawBuffer e
    bufRaw=RawBuffer Char
    raw, bufSize :: forall e. Buffer e -> Int
    bufSize=Int
    len} =
                s -> Int -> IO ()
    inner s
    s1 Int
    0
              where
                commit :: Int -> Bool -> Bool -> IO CharBuffer
    commit = Handle
    -> RawBuffer Char -> Int -> Int -> Bool -> Bool -> IO CharBuffer
    commitBuffer Handle
    h RawBuffer Char
    raw Int
    len
                inner :: s -> Int -> IO ()
    inner !s
    s !Int
    n =
                  case s -> Step s Char
    next0 s
    s of
                    Step s Char
    Done
                      | Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    len -> IO ()
    flush
                      | Bool
    otherwise -> do
                        Int
    n1 <- RawBuffer Char -> Int -> Char -> IO Int
    writeCharBuf RawBuffer Char
    raw Int
    n Char
    '\n'
                        IO CharBuffer -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO CharBuffer -> IO ()) -> IO CharBuffer -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> Bool -> Bool -> IO CharBuffer
    commit Int
    n1 Bool
    False{-no flush-} Bool
    True{-release-}
                    Skip s
    s' -> s -> Int -> IO ()
    inner s
    s' Int
    n
                    Yield Char
    x s
    s'
                      | Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    len -> IO ()
    flush
                      | Bool
    otherwise    -> RawBuffer Char -> Int -> Char -> IO Int
    writeCharBuf RawBuffer Char
    raw Int
    n Char
    x IO Int -> (Int -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= s -> Int -> IO ()
    inner s
    s'
                  where
                    flush :: IO ()
    flush = Int -> Bool -> Bool -> IO CharBuffer
    commit Int
    n Bool
    True{-needs flush-} Bool
    False{-don't release-} IO CharBuffer -> (CharBuffer -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= s -> CharBuffer -> IO ()
    outer s
    s

        writeBlocksCRLF :: Buffer CharBufElem -> Stream Char -> IO ()
        writeBlocksCRLF :: CharBuffer -> Stream Char -> IO ()
    writeBlocksCRLF CharBuffer
    buf0 (Stream s -> Step s Char
    next0 s
    s0 Size
    _len) =
            s -> CharBuffer -> IO ()
    outer s
    s0 CharBuffer
    buf0
          where
            outer :: s -> CharBuffer -> IO ()
    outer s
    s1 Buffer{bufRaw :: forall e. Buffer e -> RawBuffer e
    bufRaw=RawBuffer Char
    raw, bufSize :: forall e. Buffer e -> Int
    bufSize=Int
    len} =
                s -> Int -> IO ()
    inner s
    s1 Int
    0
              where
                commit :: Int -> Bool -> Bool -> IO CharBuffer
    commit = Handle
    -> RawBuffer Char -> Int -> Int -> Bool -> Bool -> IO CharBuffer
    commitBuffer Handle
    h RawBuffer Char
    raw Int
    len
                inner :: s -> Int -> IO ()
    inner !s
    s !Int
    n =
                  case s -> Step s Char
    next0 s
    s of
                    Step s Char
    Done
                      | Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    len -> IO ()
    flush
                      | Bool
    otherwise -> do
                        Int
    n1 <- RawBuffer Char -> Int -> Char -> IO Int
    writeCharBuf RawBuffer Char
    raw Int
    n  Char
    '\r'
                        Int
    n2 <- RawBuffer Char -> Int -> Char -> IO Int
    writeCharBuf RawBuffer Char
    raw Int
    n1 Char
    '\n'
                        IO CharBuffer -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO CharBuffer -> IO ()) -> IO CharBuffer -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> Bool -> Bool -> IO CharBuffer
    commit Int
    n2 Bool
    False{-no flush-} Bool
    True{-release-}
                    Skip s
    s' -> s -> Int -> IO ()
    inner s
    s' Int
    n
                    Yield Char
    '\n' s
    s'
                      | Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    len -> IO ()
    flush
                      | Bool
    otherwise    -> do
                          Int
    n1 <- RawBuffer Char -> Int -> Char -> IO Int
    writeCharBuf RawBuffer Char
    raw Int
    n  Char
    '\r'
                          Int
    n2 <- RawBuffer Char -> Int -> Char -> IO Int
    writeCharBuf RawBuffer Char
    raw Int
    n1 Char
    '\n'
                          s -> Int -> IO ()
    inner s
    s' Int
    n2
                    Yield Char
    x s
    s'
                      | Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    len -> IO ()
    flush
                      | Bool
    otherwise    -> RawBuffer Char -> Int -> Char -> IO Int
    writeCharBuf RawBuffer Char
    raw Int
    n Char
    x IO Int -> (Int -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= s -> Int -> IO ()
    inner s
    s'
                  where
                    flush :: IO ()
    flush = Int -> Bool -> Bool -> IO CharBuffer
    commit Int
    n Bool
    True{-needs flush-} Bool
    False{-don't release-} IO CharBuffer -> (CharBuffer -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= s -> CharBuffer -> IO ()
    outer s
    s

        commitBuffer :: Handle -> RawCharBuffer -> Int -> Int -> Bool -> Bool
                     -> IO CharBuffer
        commitBuffer :: Handle
    -> RawBuffer Char -> Int -> Int -> Bool -> Bool -> IO CharBuffer
    commitBuffer Handle
    hdl !RawBuffer Char
    raw !Int
    sz !Int
    count Bool
    flush Bool
    release =
          String -> Handle -> (Handle__ -> IO CharBuffer) -> IO CharBuffer
    forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
    wantWritableHandle String
    "commitAndReleaseBuffer" Handle
    hdl ((Handle__ -> IO CharBuffer) -> IO CharBuffer)
    -> (Handle__ -> IO CharBuffer) -> IO CharBuffer
    forall a b. (a -> b) -> a -> b
    $
            RawBuffer Char
    -> Int -> Int -> Bool -> Bool -> Handle__ -> IO CharBuffer
    commitBuffer' RawBuffer Char
    raw Int
    sz Int
    count Bool
    flush Bool
    release
    {-# SPECIALIZE hSay :: Handle -> Text -> IO () #-}

    -- | Same as 'sayString', but data is sent to the provided 'Handle'.
    --
    -- @since 0.1.0.0
    hSayString :: MonadIO m => Handle -> String -> m ()
    hSayString :: forall (m :: * -> *). MonadIO m => Handle -> String -> m ()
    hSayString Handle
    h = Handle -> Text -> m ()
    forall (m :: * -> *). MonadIO m => Handle -> Text -> m ()
    hSay Handle
    h (Text -> m ()) -> (String -> Text) -> String -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    pack
    {-# INLINE hSayString #-}

    -- | Same as 'sayShow', but data is sent to the provided 'Handle'.
    --
    -- @since 0.1.0.0
    hSayShow :: (MonadIO m, Show a) => Handle -> a -> m ()
    hSayShow :: forall (m :: * -> *) a. (MonadIO m, Show a) => Handle -> a -> m ()
    hSayShow Handle
    h = Handle -> String -> m ()
    forall (m :: * -> *). MonadIO m => Handle -> String -> m ()
    hSayString Handle
    h (String -> m ()) -> (a -> String) -> a -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> String
    forall a. Show a => a -> String
    show
    {-# INLINE hSayShow #-}