{-# LANGUAGE OverloadedStrings #-}
module Network.GRPC.Spec.Serialization.Timeout (
buildTimeout
, parseTimeout
) where
import Control.Monad.Except
import Data.ByteString qualified as BS.Strict
import Data.ByteString qualified as Strict (ByteString)
import Data.ByteString.Char8 qualified as BS.Strict.C8
import Data.Char (isDigit)
import Network.GRPC.Spec
buildTimeout :: Timeout -> Strict.ByteString
buildTimeout :: Timeout -> ByteString
buildTimeout (Timeout TimeoutUnit
unit TimeoutValue
val) = [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat [
String -> ByteString
BS.Strict.C8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Word -> String
forall a. Show a => a -> String
show (Word -> String) -> Word -> String
forall a b. (a -> b) -> a -> b
$ TimeoutValue -> Word
getTimeoutValue TimeoutValue
val
, case TimeoutUnit
unit of
TimeoutUnit
Hour -> ByteString
"H"
TimeoutUnit
Minute -> ByteString
"M"
TimeoutUnit
Second -> ByteString
"S"
TimeoutUnit
Millisecond -> ByteString
"m"
TimeoutUnit
Microsecond -> ByteString
"u"
TimeoutUnit
Nanosecond -> ByteString
"n"
]
parseTimeout :: forall m. MonadError String m => Strict.ByteString -> m Timeout
parseTimeout :: forall (m :: * -> *).
MonadError String m =>
ByteString -> m Timeout
parseTimeout ByteString
bs = do
let (ByteString
bsVal, ByteString
bsUnit) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.Strict.C8.span Char -> Bool
isDigit ByteString
bs
val <-
if ByteString -> Int
BS.Strict.length ByteString
bsVal Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| ByteString -> Int
BS.Strict.length ByteString
bsVal Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
8
then m TimeoutValue
forall a. m a
invalid
else TimeoutValue -> m TimeoutValue
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeoutValue -> m TimeoutValue)
-> (Word -> TimeoutValue) -> Word -> m TimeoutValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> TimeoutValue
TimeoutValue (Word -> m TimeoutValue) -> Word -> m TimeoutValue
forall a b. (a -> b) -> a -> b
$ String -> Word
forall a. Read a => String -> a
read (ByteString -> String
BS.Strict.C8.unpack ByteString
bsVal)
charUnit <-
case BS.Strict.C8.uncons bsUnit of
Maybe (Char, ByteString)
Nothing ->
m Char
forall a. m a
invalid
Just (Char
u, ByteString
remainder) ->
if ByteString -> Bool
BS.Strict.null ByteString
remainder
then Char -> m Char
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
u
else m Char
forall a. m a
invalid
unit <-
case charUnit of
Char
'H' -> TimeoutUnit -> m TimeoutUnit
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TimeoutUnit
Hour
Char
'M' -> TimeoutUnit -> m TimeoutUnit
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TimeoutUnit
Minute
Char
'S' -> TimeoutUnit -> m TimeoutUnit
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TimeoutUnit
Second
Char
'm' -> TimeoutUnit -> m TimeoutUnit
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TimeoutUnit
Millisecond
Char
'u' -> TimeoutUnit -> m TimeoutUnit
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TimeoutUnit
Microsecond
Char
'n' -> TimeoutUnit -> m TimeoutUnit
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TimeoutUnit
Nanosecond
Char
_ -> m TimeoutUnit
forall a. m a
invalid
return $ Timeout unit val
where
invalid :: m a
invalid :: forall a. m a
invalid = String -> m a
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"Could not parse timeout " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
bs