{-# LANGUAGE CPP       #-}
{-# LANGUAGE MagicHash #-}

{-|
Module:      TextShow.Utils
Copyright:   (C) 2014-2017 Ryan Scott
License:     BSD-style (see the file LICENSE)
Maintainer:  Ryan Scott
Stability:   Provisional
Portability: GHC

Miscellaneous utility functions.
-}
module TextShow.Utils (
      coerce
    , i2d
    , isInfixDataCon
    , isSymVar
    , isTupleString
    , lengthB
    , toString
    , toText
    , unlinesB
    , unwordsB
    ) where

import           Data.Int (Int64)
import           Data.Text (Text)
import           Data.Text.Lazy (length, toStrict, unpack)
import           Data.Text.Lazy.Builder (Builder, singleton, toLazyText)

import           GHC.Exts (Char(C#), Int(I#), (+#), chr#, ord#)

import           Prelude ()
import           Prelude.Compat hiding (length)

#if __GLASGOW_HASKELL__ >= 708
import qualified Data.Coerce as C (Coercible, coerce)
#else
import           Unsafe.Coerce (unsafeCoerce)
#endif

#if defined(MIN_VERSION_ghc_boot_th)
import           GHC.Lexeme (startsVarSym)
#else
import           Data.Char (isSymbol, ord)
#endif

-- | On GHC 7.8 and later, this is 'C.coerce' from "Data.Coerce". Otherwise, it's
-- 'unsafeCoerce'.
#if __GLASGOW_HASKELL__ >= 708
coerce :: C.Coercible a b => a -> b
coerce :: a -> b
coerce = a -> b
C.coerce
#else
coerce :: a -> b
coerce = unsafeCoerce
#endif

-- | Unsafe conversion for decimal digits.
i2d :: Int -> Char
i2d :: Int -> Char
i2d (I# Int#
i#) = Char# -> Char
C# (Int# -> Char#
chr# (Char# -> Int#
ord# Char#
'0'# Int# -> Int# -> Int#
+# Int#
i#))
{-# INLINE i2d #-}

-- | Checks if a 'String' names a valid Haskell infix data constructor (i.e., does
-- it begin with a colon?).
isInfixDataCon :: String -> Bool
isInfixDataCon :: String -> Bool
isInfixDataCon (Char
':':String
_) = Bool
True
isInfixDataCon String
_       = Bool
False
{-# INLINE isInfixDataCon #-}

-- | Checks if a 'String' names a valid Haskell infix, non-constructor function.
isSymVar :: String -> Bool
isSymVar :: String -> Bool
isSymVar String
""      = Bool
False
isSymVar (Char
c : String
_) = Char -> Bool
startsVarSym Char
c

#if !defined(MIN_VERSION_ghc_boot_th)
startsVarSym :: Char -> Bool
startsVarSym c = startsVarSymASCII c || (ord c > 0x7f && isSymbol c) -- Infix Ids

startsVarSymASCII :: Char -> Bool
startsVarSymASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
#endif

-- | Checks if a 'String' represents a tuple (other than '()')
isTupleString :: String -> Bool
isTupleString :: String -> Bool
isTupleString (Char
'(':Char
',':String
_) = Bool
True
isTupleString String
_           = Bool
False
{-# INLINE isTupleString #-}

-- | Computes the length of a 'Builder'.
--
-- /Since: 2/
lengthB :: Builder -> Int64
lengthB :: Builder -> Int64
lengthB = Text -> Int64
length (Text -> Int64) -> (Builder -> Text) -> Builder -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText
{-# INLINE lengthB #-}

-- | Convert a 'Builder' to a 'String' (without surrounding it with double quotes,
-- as 'show' would).
--
-- /Since: 2/
toString :: Builder -> String
toString :: Builder -> String
toString = Text -> String
unpack (Text -> String) -> (Builder -> Text) -> Builder -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText
{-# INLINE toString #-}

-- | Convert a 'Builder' to a strict 'Text'.
--
-- /Since: 2/
toText :: Builder -> Text
toText :: Builder -> Text
toText = Text -> Text
toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText
{-# INLINE toText #-}

-- | Merges several 'Builder's, separating them by newlines.
--
-- /Since: 2/
unlinesB :: [Builder] -> Builder
unlinesB :: [Builder] -> Builder
unlinesB (Builder
b:[Builder]
bs) = Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'\n' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
unlinesB [Builder]
bs
unlinesB []     = Builder
forall a. Monoid a => a
mempty

-- | Merges several 'Builder's, separating them by spaces.
--
-- /Since: 2/
unwordsB :: [Builder] -> Builder
unwordsB :: [Builder] -> Builder
unwordsB (Builder
b:bs :: [Builder]
bs@(Builder
_:[Builder]
_)) = Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
' ' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
unwordsB [Builder]
bs
unwordsB [Builder
b]          = Builder
b
unwordsB []           = Builder
forall a. Monoid a => a
mempty