{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict #-}
module DataFrame.Internal.Parsing where

import qualified Data.ByteString.Char8 as C
import qualified Data.Set as S
import qualified Data.Text as T

import Data.Text.Read
import Data.Maybe (fromMaybe)
import GHC.Stack (HasCallStack)
import Text.Read (readMaybe)

isNullish :: T.Text -> Bool
isNullish :: Text -> Bool
isNullish Text
s = Text
s Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList [Text
"Nothing", Text
"NULL", Text
"", Text
" ", Text
"nan"]

readValue :: (HasCallStack, Read a) => T.Text -> a
readValue :: forall a. (HasCallStack, Read a) => Text -> a
readValue Text
s = case [Char] -> Maybe a
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
T.unpack Text
s) of
  Maybe a
Nothing -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"Could not read value: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
s
  Just a
value -> a
value

readInteger :: (HasCallStack) => T.Text -> Maybe Integer
readInteger :: HasCallStack => Text -> Maybe Integer
readInteger Text
s = case Reader Integer -> Reader Integer
forall a. Num a => Reader a -> Reader a
signed Reader Integer
forall a. Integral a => Reader a
decimal (Text -> Text
T.strip Text
s) of
  Left [Char]
_ -> Maybe Integer
forall a. Maybe a
Nothing
  Right (Integer
value, Text
"") -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
value
  Right (Integer
value, Text
_) -> Maybe Integer
forall a. Maybe a
Nothing

readInt :: (HasCallStack) => T.Text -> Maybe Int
readInt :: HasCallStack => Text -> Maybe Int
readInt Text
s = case Reader Int -> Reader Int
forall a. Num a => Reader a -> Reader a
signed Reader Int
forall a. Integral a => Reader a
decimal (Text -> Text
T.strip Text
s) of
  Left [Char]
_ -> Maybe Int
forall a. Maybe a
Nothing
  Right (Int
value, Text
"") -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
value
  Right (Int
value, Text
_) -> Maybe Int
forall a. Maybe a
Nothing
{-# INLINE readInt #-}

readByteStringInt :: (HasCallStack) => C.ByteString -> Maybe Int
readByteStringInt :: HasCallStack => ByteString -> Maybe Int
readByteStringInt ByteString
s = case ByteString -> Maybe (Int, ByteString)
C.readInt (ByteString -> ByteString
C.strip ByteString
s) of
  Maybe (Int, ByteString)
Nothing -> Maybe Int
forall a. Maybe a
Nothing
  Just (Int
value, ByteString
"") -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
value
  Just (Int
value, ByteString
_) -> Maybe Int
forall a. Maybe a
Nothing
{-# INLINE readByteStringInt #-}

readDouble :: (HasCallStack) => T.Text -> Maybe Double
readDouble :: HasCallStack => Text -> Maybe Double
readDouble Text
s =
  case Reader Double -> Reader Double
forall a. Num a => Reader a -> Reader a
signed Reader Double
double Text
s of
    Left [Char]
_ -> Maybe Double
forall a. Maybe a
Nothing
    Right (Double
value, Text
"") -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
value
    Right (Double
value, Text
_) -> Maybe Double
forall a. Maybe a
Nothing
{-# INLINE readDouble #-}

readIntegerEither :: (HasCallStack) => T.Text -> Either T.Text Integer
readIntegerEither :: HasCallStack => Text -> Either Text Integer
readIntegerEither Text
s = case Reader Integer -> Reader Integer
forall a. Num a => Reader a -> Reader a
signed Reader Integer
forall a. Integral a => Reader a
decimal (Text -> Text
T.strip Text
s) of
  Left [Char]
_ -> Text -> Either Text Integer
forall a b. a -> Either a b
Left Text
s
  Right (Integer
value, Text
"") -> Integer -> Either Text Integer
forall a b. b -> Either a b
Right Integer
value
  Right (Integer
value, Text
_) -> Text -> Either Text Integer
forall a b. a -> Either a b
Left Text
s
{-# INLINE readIntegerEither #-}

readIntEither :: (HasCallStack) => T.Text -> Either T.Text Int
readIntEither :: HasCallStack => Text -> Either Text Int
readIntEither Text
s = case Reader Int -> Reader Int
forall a. Num a => Reader a -> Reader a
signed Reader Int
forall a. Integral a => Reader a
decimal (Text -> Text
T.strip Text
s) of
  Left [Char]
_ -> Text -> Either Text Int
forall a b. a -> Either a b
Left Text
s
  Right (Int
value, Text
"") -> Int -> Either Text Int
forall a b. b -> Either a b
Right Int
value
  Right (Int
value, Text
_) -> Text -> Either Text Int
forall a b. a -> Either a b
Left Text
s
{-# INLINE readIntEither #-}

readDoubleEither :: (HasCallStack) => T.Text -> Either T.Text Double
readDoubleEither :: HasCallStack => Text -> Either Text Double
readDoubleEither Text
s =
  case Reader Double -> Reader Double
forall a. Num a => Reader a -> Reader a
signed Reader Double
double Text
s of
    Left [Char]
_ -> Text -> Either Text Double
forall a b. a -> Either a b
Left Text
s
    Right (Double
value, Text
"") -> Double -> Either Text Double
forall a b. b -> Either a b
Right Double
value
    Right (Double
value, Text
_) -> Text -> Either Text Double
forall a b. a -> Either a b
Left Text
s
{-# INLINE readDoubleEither #-}

safeReadValue :: (Read a) => T.Text -> Maybe a
safeReadValue :: forall a. Read a => Text -> Maybe a
safeReadValue Text
s = [Char] -> Maybe a
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
T.unpack Text
s)

readWithDefault :: (HasCallStack, Read a) => a -> T.Text -> a
readWithDefault :: forall a. (HasCallStack, Read a) => a -> Text -> a
readWithDefault a
v Text
s = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
v ([Char] -> Maybe a
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
T.unpack Text
s))