{-# LANGUAGE CPP, FlexibleInstances, OverloadedStrings #-}

-- |
-- Module      : Data.Text.Buildable
-- Copyright   : (c) 2011 MailRank, Inc.
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- Types that can be rendered to a 'Builder'.

module Formatting.Buildable
    (
      Buildable(..)
    ) where

import           Data.Int (Int8, Int16, Int32, Int64)
import           Data.Fixed (Fixed, HasResolution, showFixed)
import           Data.List (intersperse)
import           Data.Ratio (Ratio, denominator, numerator)
import qualified Data.Text.Format.Functions as F ((<>))
import           Data.Text.Lazy.Builder.Int (decimal, hexadecimal)
import           Data.Text.Format.Types (Hex(..), Shown(..))
import           Data.Text.Lazy.Builder
import           Data.Time.Calendar (Day, showGregorian)
import           Data.Time.Clock (getModJulianDate, DiffTime, NominalDiffTime, UTCTime, UniversalTime)
import           Data.Time.LocalTime (LocalTime, TimeOfDay, TimeZone, ZonedTime)
import           Data.Void (Void, absurd)
import           Data.Word (Word8, Word16, Word32, Word64)
import           Foreign.Ptr (IntPtr, WordPtr, Ptr, ptrToWordPtr)
import qualified Data.Text as ST
import qualified Data.Text.Lazy as LT

-- | The class of types that can be rendered to a 'Builder'.
class Buildable p where
    build :: p -> Builder

instance Buildable Builder where
    build :: Builder -> Builder
build = Builder -> Builder
forall a. a -> a
id

instance Buildable Void where
    build :: Void -> Builder
build = Void -> Builder
forall a. Void -> a
absurd

instance Buildable LT.Text where
    build :: Text -> Builder
build = Text -> Builder
fromLazyText
    {-# INLINE build #-}

instance Buildable ST.Text where
    build :: Text -> Builder
build = Text -> Builder
fromText
    {-# INLINE build #-}

instance Buildable Char where
    build :: Char -> Builder
build = Char -> Builder
singleton
    {-# INLINE build #-}

instance Buildable [Char] where
    build :: [Char] -> Builder
build = [Char] -> Builder
fromString
    {-# INLINE build #-}

instance (Integral a) => Buildable (Hex a) where
    build :: Hex a -> Builder
build = Hex a -> Builder
forall a. Integral a => a -> Builder
hexadecimal
    {-# INLINE build #-}

instance Buildable Int8 where
    build :: Int8 -> Builder
build = Int8 -> Builder
forall a. Integral a => a -> Builder
decimal
    {-# INLINE build #-}

instance Buildable Int16 where
    build :: Int16 -> Builder
build = Int16 -> Builder
forall a. Integral a => a -> Builder
decimal
    {-# INLINE build #-}

instance Buildable Int32 where
    build :: Int32 -> Builder
build = Int32 -> Builder
forall a. Integral a => a -> Builder
decimal
    {-# INLINE build #-}

instance Buildable Int where
    build :: Int -> Builder
build = Int -> Builder
forall a. Integral a => a -> Builder
decimal
    {-# INLINE build #-}

instance Buildable Int64 where
    build :: Int64 -> Builder
build = Int64 -> Builder
forall a. Integral a => a -> Builder
decimal
    {-# INLINE build #-}

instance Buildable Integer where
    build :: Integer -> Builder
build = Integer -> Builder
forall a. Integral a => a -> Builder
decimal
    {-# INLINE build #-}

instance (HasResolution a) => Buildable (Fixed a) where
    build :: Fixed a -> Builder
build = [Char] -> Builder
forall p. Buildable p => p -> Builder
build ([Char] -> Builder) -> (Fixed a -> [Char]) -> Fixed a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Fixed a -> [Char]
forall k (a :: k). HasResolution a => Bool -> Fixed a -> [Char]
showFixed Bool
False
    {-# INLINE build #-}

instance Buildable Word8 where
    build :: Word8 -> Builder
build = Word8 -> Builder
forall a. Integral a => a -> Builder
decimal
    {-# INLINE build #-}

instance Buildable Word16 where
    build :: Word16 -> Builder
build = Word16 -> Builder
forall a. Integral a => a -> Builder
decimal
    {-# INLINE build #-}

instance Buildable Word32 where
    build :: Word32 -> Builder
build = Word32 -> Builder
forall a. Integral a => a -> Builder
decimal
    {-# INLINE build #-}

instance Buildable Word where
    build :: Word -> Builder
build = Word -> Builder
forall a. Integral a => a -> Builder
decimal
    {-# INLINE build #-}

instance Buildable Word64 where
    build :: Word64 -> Builder
build = Word64 -> Builder
forall a. Integral a => a -> Builder
decimal
    {-# INLINE build #-}

instance Buildable a => Buildable (Ratio a) where
    {-# SPECIALIZE instance Buildable (Ratio Integer) #-}
    build :: Ratio a -> Builder
build Ratio a
a = a -> Builder
forall p. Buildable p => p -> Builder
build (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
a) Builder -> Builder -> Builder
F.<> Char -> Builder
singleton Char
'/' Builder -> Builder -> Builder
F.<> a -> Builder
forall p. Buildable p => p -> Builder
build (Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
a)

instance Buildable Float where
    build :: Float -> Builder
build = [Char] -> Builder
forall p. Buildable p => p -> Builder
build ([Char] -> Builder) -> (Float -> [Char]) -> Float -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> [Char]
forall a. Show a => a -> [Char]
show
    {-# INLINE build #-}

instance Buildable Double where
    build :: Double -> Builder
build = [Char] -> Builder
forall p. Buildable p => p -> Builder
build ([Char] -> Builder) -> (Double -> [Char]) -> Double -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> [Char]
forall a. Show a => a -> [Char]
show
    {-# INLINE build #-}

instance Buildable DiffTime where
    build :: DiffTime -> Builder
build = Shown DiffTime -> Builder
forall p. Buildable p => p -> Builder
build (Shown DiffTime -> Builder)
-> (DiffTime -> Shown DiffTime) -> DiffTime -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Shown DiffTime
forall a. a -> Shown a
Shown
    {-# INLINE build #-}

instance Buildable NominalDiffTime where
    build :: NominalDiffTime -> Builder
build = Shown NominalDiffTime -> Builder
forall p. Buildable p => p -> Builder
build (Shown NominalDiffTime -> Builder)
-> (NominalDiffTime -> Shown NominalDiffTime)
-> NominalDiffTime
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> Shown NominalDiffTime
forall a. a -> Shown a
Shown
    {-# INLINE build #-}

instance Buildable UTCTime where
    build :: UTCTime -> Builder
build = Shown UTCTime -> Builder
forall p. Buildable p => p -> Builder
build (Shown UTCTime -> Builder)
-> (UTCTime -> Shown UTCTime) -> UTCTime -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Shown UTCTime
forall a. a -> Shown a
Shown
    {-# INLINE build #-}

instance Buildable UniversalTime where
    build :: UniversalTime -> Builder
build = Shown Rational -> Builder
forall p. Buildable p => p -> Builder
build (Shown Rational -> Builder)
-> (UniversalTime -> Shown Rational) -> UniversalTime -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Shown Rational
forall a. a -> Shown a
Shown (Rational -> Shown Rational)
-> (UniversalTime -> Rational) -> UniversalTime -> Shown Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniversalTime -> Rational
getModJulianDate
    {-# INLINE build #-}

instance Buildable Day where
    build :: Day -> Builder
build = [Char] -> Builder
fromString ([Char] -> Builder) -> (Day -> [Char]) -> Day -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> [Char]
showGregorian
    {-# INLINE build #-}

instance (Show a) => Buildable (Shown a) where
    build :: Shown a -> Builder
build = [Char] -> Builder
fromString ([Char] -> Builder) -> (Shown a -> [Char]) -> Shown a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show (a -> [Char]) -> (Shown a -> a) -> Shown a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shown a -> a
forall a. Shown a -> a
shown
    {-# INLINE build #-}

instance (Buildable a) => Buildable (Maybe a) where
    build :: Maybe a -> Builder
build Maybe a
Nothing = Builder
forall a. Monoid a => a
mempty
    build (Just a
v) = a -> Builder
forall p. Buildable p => p -> Builder
build a
v
    {-# INLINE build #-}

instance Buildable TimeOfDay where
    build :: TimeOfDay -> Builder
build = Shown TimeOfDay -> Builder
forall p. Buildable p => p -> Builder
build (Shown TimeOfDay -> Builder)
-> (TimeOfDay -> Shown TimeOfDay) -> TimeOfDay -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeOfDay -> Shown TimeOfDay
forall a. a -> Shown a
Shown
    {-# INLINE build #-}

instance Buildable TimeZone where
    build :: TimeZone -> Builder
build = Shown TimeZone -> Builder
forall p. Buildable p => p -> Builder
build (Shown TimeZone -> Builder)
-> (TimeZone -> Shown TimeZone) -> TimeZone -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> Shown TimeZone
forall a. a -> Shown a
Shown
    {-# INLINE build #-}

instance Buildable LocalTime where
    build :: LocalTime -> Builder
build = Shown LocalTime -> Builder
forall p. Buildable p => p -> Builder
build (Shown LocalTime -> Builder)
-> (LocalTime -> Shown LocalTime) -> LocalTime -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> Shown LocalTime
forall a. a -> Shown a
Shown
    {-# INLINE build #-}

instance Buildable ZonedTime where
    build :: ZonedTime -> Builder
build = Shown ZonedTime -> Builder
forall p. Buildable p => p -> Builder
build (Shown ZonedTime -> Builder)
-> (ZonedTime -> Shown ZonedTime) -> ZonedTime -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> Shown ZonedTime
forall a. a -> Shown a
Shown
    {-# INLINE build #-}

instance Buildable IntPtr where
    build :: IntPtr -> Builder
build IntPtr
p = Text -> Builder
fromText Text
"0x" Builder -> Builder -> Builder
F.<> IntPtr -> Builder
forall a. Integral a => a -> Builder
hexadecimal IntPtr
p

instance Buildable WordPtr where
    build :: WordPtr -> Builder
build WordPtr
p = Text -> Builder
fromText Text
"0x" Builder -> Builder -> Builder
F.<> WordPtr -> Builder
forall a. Integral a => a -> Builder
hexadecimal WordPtr
p

instance Buildable (Ptr a) where
    build :: Ptr a -> Builder
build = WordPtr -> Builder
forall p. Buildable p => p -> Builder
build (WordPtr -> Builder) -> (Ptr a -> WordPtr) -> Ptr a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr a -> WordPtr
forall a. Ptr a -> WordPtr
ptrToWordPtr

instance Buildable Bool where
    build :: Bool -> Builder
build Bool
True = Text -> Builder
fromText Text
"True"
    build Bool
False = Text -> Builder
fromText Text
"False"

instance {-# OVERLAPPABLE #-} Buildable a => Buildable [a] where
    build :: [a] -> Builder
build [a]
xs = Builder
"[" Builder -> Builder -> Builder
F.<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
"," ((a -> Builder) -> [a] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map a -> Builder
forall p. Buildable p => p -> Builder
build [a]
xs)) Builder -> Builder -> Builder
F.<> Builder
"]"
    {-# INLINE build #-}