module PGExtras.Helpers (
  maybeText,
  maybeInt,
  maybeRational,
  maybeBool,
  maybeZonedTime
) where


import qualified Data.Text as Text
import Data.Time (ZonedTime)
import Data.Ratio

nullString :: [Char]
nullString :: [Char]
nullString = "NULL"

maybeInt :: Maybe Int -> [Char]
maybeInt :: Maybe Int -> [Char]
maybeInt Nothing = [Char]
nullString
maybeInt (Just x :: Int
x) = Int -> [Char]
forall a. Show a => a -> [Char]
show Int
x

maybeRational :: Maybe Rational -> [Char]
maybeRational :: Maybe Rational -> [Char]
maybeRational Nothing = [Char]
nullString
maybeRational (Just x :: Rational
x) = Rational -> [Char]
showRational Rational
x

maybeText :: Maybe Text.Text -> [Char]
maybeText :: Maybe Text -> [Char]
maybeText Nothing = [Char]
nullString
maybeText (Just x :: Text
x) = Text -> [Char]
Text.unpack(Text
x)

maybeBool :: Maybe Bool -> [Char]
maybeBool :: Maybe Bool -> [Char]
maybeBool Nothing = [Char]
nullString
maybeBool (Just x :: Bool
x) = Bool -> [Char]
forall a. Show a => a -> [Char]
show Bool
x

maybeZonedTime :: Maybe ZonedTime -> [Char]
maybeZonedTime :: Maybe ZonedTime -> [Char]
maybeZonedTime Nothing = [Char]
nullString
maybeZonedTime (Just x :: ZonedTime
x) = ZonedTime -> [Char]
forall a. Show a => a -> [Char]
show ZonedTime
x

showRational :: Rational -> [Char]
showRational :: Rational -> [Char]
showRational rat :: Rational
rat = (if Integer
num Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0 then "-" else "") [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Integer -> [Char] -> [Char]
forall a. Show a => a -> [Char] -> [Char]
shows Integer
d ("." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take 4 (Integer -> [Char]
go Integer
next)))
    where
        (d :: Integer
d, next :: Integer
next) = Integer -> Integer
forall a. Num a => a -> a
abs Integer
num Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
den
        num :: Integer
num = Rational -> Integer
forall a. Ratio a -> a
numerator Rational
rat
        den :: Integer
den = Rational -> Integer
forall a. Ratio a -> a
denominator Rational
rat

        go :: Integer -> [Char]
go 0 = ""
        go x :: Integer
x = let (d :: Integer
d, next :: Integer
next) = (10 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x) Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
den
               in Integer -> [Char] -> [Char]
forall a. Show a => a -> [Char] -> [Char]
shows Integer
d (Integer -> [Char]
go Integer
next)