module Codec.Xlsx.Parser.Internal.Util
  ( boolean
  , eitherBoolean
  , decimal
  , eitherDecimal
  , rational
  , eitherRational
  ) where

import Data.Text (Text)
import Control.Monad.Fail (MonadFail)
import qualified Data.Text as T
import qualified Data.Text.Read as T
import qualified Control.Monad.Fail as F

decimal :: (MonadFail m, Integral a) => Text -> m a
decimal :: forall (m :: * -> *) a. (MonadFail m, Integral a) => Text -> m a
decimal = Either String a -> m a
forall (m :: * -> *) b. MonadFail m => Either String b -> m b
fromEither (Either String a -> m a)
-> (Text -> Either String a) -> Text -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String a
forall a. Integral a => Text -> Either String a
eitherDecimal

eitherDecimal :: (Integral a) => Text -> Either String a
eitherDecimal :: forall a. Integral a => Text -> Either String a
eitherDecimal Text
t = case Reader a -> Reader a
forall a. Num a => Reader a -> Reader a
T.signed Reader a
forall a. Integral a => Reader a
T.decimal Text
t of
  Right (a
d, Text
leftover) | Text -> Bool
T.null Text
leftover -> a -> Either String a
forall a b. b -> Either a b
Right a
d
  Either String (a, Text)
_ -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"invalid decimal: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t

rational :: (MonadFail m) => Text -> m Double
rational :: forall (m :: * -> *). MonadFail m => Text -> m Double
rational = Either String Double -> m Double
forall (m :: * -> *) b. MonadFail m => Either String b -> m b
fromEither (Either String Double -> m Double)
-> (Text -> Either String Double) -> Text -> m Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String Double
eitherRational

eitherRational :: Text -> Either String Double
eitherRational :: Text -> Either String Double
eitherRational Text
t = case Reader Double -> Reader Double
forall a. Num a => Reader a -> Reader a
T.signed Reader Double
forall a. Fractional a => Reader a
T.rational Text
t of
  Right (Double
r, Text
leftover) | Text -> Bool
T.null Text
leftover -> Double -> Either String Double
forall a b. b -> Either a b
Right Double
r
  Either String (Double, Text)
_ -> String -> Either String Double
forall a b. a -> Either a b
Left (String -> Either String Double) -> String -> Either String Double
forall a b. (a -> b) -> a -> b
$ String
"invalid rational: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t

boolean :: (MonadFail m) => Text -> m Bool
boolean :: forall (m :: * -> *). MonadFail m => Text -> m Bool
boolean = Either String Bool -> m Bool
forall (m :: * -> *) b. MonadFail m => Either String b -> m b
fromEither (Either String Bool -> m Bool)
-> (Text -> Either String Bool) -> Text -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String Bool
eitherBoolean

eitherBoolean :: Text -> Either String Bool
eitherBoolean :: Text -> Either String Bool
eitherBoolean Text
t = case Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
t of
    String
"true"  -> Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
True
    String
"false" -> Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
False
    String
_       -> String -> Either String Bool
forall a b. a -> Either a b
Left (String -> Either String Bool) -> String -> Either String Bool
forall a b. (a -> b) -> a -> b
$ String
"invalid boolean: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t

fromEither :: (MonadFail m) => Either String b -> m b
fromEither :: forall (m :: * -> *) b. MonadFail m => Either String b -> m b
fromEither (Left String
a) = String -> m b
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
F.fail String
a
fromEither (Right b
b) = b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
b