{-# LANGUAGE MagicHash         #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}

-- Module      : Data.Text.Manipulate.Internal.Types
-- Copyright   : (c) 2014-2015 Brendan Hay <brendan.g.hay@gmail.com>
-- License     : This Source Code Form is subject to the terms of
--               the Mozilla Public License, v. 2.0.
--               A copy of the MPL can be found in the LICENSE file or
--               you can obtain it at http://mozilla.org/MPL/2.0/.
-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)

module Data.Text.Manipulate.Internal.Types where

import           Control.Monad
import qualified Data.Char              as Char
import           Data.Monoid
import           Data.Text.Lazy.Builder (Builder, singleton)
import           GHC.Base

-- | Returns 'True' for any boundary or uppercase character.
isWordBoundary :: Char -> Bool
isWordBoundary :: Char -> Bool
isWordBoundary c :: Char
c = Char -> Bool
Char.isUpper Char
c Bool -> Bool -> Bool
|| Char -> Bool
isBoundary Char
c

-- | Returns 'True' for any boundary character.
isBoundary :: Char -> Bool
isBoundary :: Char -> Bool
isBoundary = Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
Char.isAlphaNum

ordinal :: Integral a => a -> Builder
ordinal :: a -> Builder
ordinal (a -> Integer
forall a. Integral a => a -> Integer
toInteger -> Integer
n) = Integer -> Builder
forall a. Integral a => a -> Builder
decimal Integer
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
suf
      where
        suf :: Builder
suf | Integer
x Integer -> [Integer] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [11..13] = "th"
            | Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 1            = "st"
            | Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 2            = "nd"
            | Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 3            = "rd"
            | Bool
otherwise         = "th"

        ((Integer -> Integer -> Integer) -> Integer -> Integer -> Integer
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod 100 -> Integer
x, (Integer -> Integer -> Integer) -> Integer -> Integer -> Integer
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod 10 -> Integer
y) = (Integer -> Integer -> (Integer, Integer))
-> Integer -> (Integer, Integer)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (,) (Integer -> Integer
forall a. Num a => a -> a
abs Integer
n)
{-# NOINLINE[0] ordinal #-}

decimal :: Integral a => a -> Builder
{-# SPECIALIZE decimal :: Int -> Builder #-}
decimal :: a -> Builder
decimal i :: a
i
    | a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0     = Char -> Builder
singleton '-' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
forall a. Integral a => a -> Builder
go (-a
i)
    | Bool
otherwise = a -> Builder
forall a. Integral a => a -> Builder
go a
i
  where
    go :: a -> Builder
go n :: a
n | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 10    = a -> Builder
forall a. Integral a => a -> Builder
digit a
n
         | Bool
otherwise = a -> Builder
go (a
n a -> a -> a
forall a. Integral a => a -> a -> a
`quot` 10) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
forall a. Integral a => a -> Builder
digit (a
n a -> a -> a
forall a. Integral a => a -> a -> a
`rem` 10)
{-# NOINLINE[0] decimal #-}

digit :: Integral a => a -> Builder
digit :: a -> Builder
digit n :: a
n = Char -> Builder
singleton (Char -> Builder) -> Char -> Builder
forall a b. (a -> b) -> a -> b
$! Int -> Char
i2d (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n)
{-# INLINE digit #-}

i2d :: Int -> Char
i2d :: Int -> Char
i2d (I# i# :: Int#
i#) = Char# -> Char
C# (Int# -> Char#
chr# (Char# -> Int#
ord# '0'# Int# -> Int# -> Int#
+# Int#
i#))
{-# INLINE i2d #-}