module Freckle.App.Env
( module Env
, Off (..)
, On (..)
, flag
, Timeout (..)
, eitherReader
, time
, keyValues
, keyValue
, splitOnParse
, timeout
) where
import Freckle.App.Prelude
import Control.Error.Util (note)
import Data.Char (isDigit)
import qualified Data.Text as T
import Data.Time (defaultTimeLocale, parseTimeM)
import Env hiding (flag)
import qualified Env
import qualified Prelude as Unsafe (read)
newtype Off a = Off a
newtype On a = On a
flag :: Off a -> On a -> String -> Mod Flag a -> Parser Error a
flag :: forall a. Off a -> On a -> String -> Mod Flag a -> Parser Error a
flag (Off a
f) (On a
t) String
n Mod Flag a
m = a -> a -> String -> Mod Flag a -> Parser Error a
forall a e. a -> a -> String -> Mod Flag a -> Parser e a
Env.flag a
f a
t String
n Mod Flag a
m
eitherReader :: (String -> Either String a) -> Reader Error a
eitherReader :: forall a. (String -> Either String a) -> Reader Error a
eitherReader String -> Either String a
f String
s = (String -> Error) -> Either String a -> Either Error a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Error
forall e. AsUnread e => String -> e
unread (String -> Error) -> (String -> String) -> String -> Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
suffix) (Either String a -> Either Error a)
-> Either String a -> Either Error a
forall a b. (a -> b) -> a -> b
$ String -> Either String a
f String
s
where
suffix :: String -> String
suffix String
x = String
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
s
time :: String -> Reader Error UTCTime
time :: String -> Reader Error UTCTime
time String
fmt =
(String -> Either String UTCTime) -> Reader Error UTCTime
forall a. (String -> Either String a) -> Reader Error a
eitherReader ((String -> Either String UTCTime) -> Reader Error UTCTime)
-> (String -> Either String UTCTime) -> Reader Error UTCTime
forall a b. (a -> b) -> a -> b
$
String -> Maybe UTCTime -> Either String UTCTime
forall a b. a -> Maybe b -> Either a b
note (String
"unable to parse time as " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fmt)
(Maybe UTCTime -> Either String UTCTime)
-> (String -> Maybe UTCTime) -> String -> Either String UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
fmt
keyValues :: Reader Error [(Text, Text)]
keyValues :: Reader Error [(Text, Text)]
keyValues = Char -> Reader Error (Text, Text) -> Reader Error [(Text, Text)]
forall e a. Char -> Reader e a -> Reader e [a]
splitOnParse Char
',' (Reader Error (Text, Text) -> Reader Error [(Text, Text)])
-> Reader Error (Text, Text) -> Reader Error [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ Char -> Reader Error (Text, Text)
keyValue Char
':'
keyValue :: Char -> Reader Error (Text, Text)
keyValue :: Char -> Reader Error (Text, Text)
keyValue Char
c =
(String -> Either String (Text, Text)) -> Reader Error (Text, Text)
forall a. (String -> Either String a) -> Reader Error a
eitherReader ((String -> Either String (Text, Text))
-> Reader Error (Text, Text))
-> (String -> Either String (Text, Text))
-> Reader Error (Text, Text)
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> Either String (Text, Text)
go ((Text, Text) -> Either String (Text, Text))
-> (String -> (Text, Text)) -> String -> Either String (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> (Text, Text) -> (Text, Text)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Int -> Text -> Text
T.drop Int
1) ((Text, Text) -> (Text, Text))
-> (String -> (Text, Text)) -> String -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn (Char -> Text
T.singleton Char
c) (Text -> (Text, Text))
-> (String -> Text) -> String -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack
where
go :: (Text, Text) -> Either String (Text, Text)
go = \case
(Text
k, Text
v) | Text -> Bool
T.null Text
v -> String -> Either String (Text, Text)
forall a b. a -> Either a b
Left (String -> Either String (Text, Text))
-> String -> Either String (Text, Text)
forall a b. (a -> b) -> a -> b
$ String
"Key " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
k String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" has no value"
(Text
k, Text
v) | Text -> Bool
T.null Text
k -> String -> Either String (Text, Text)
forall a b. a -> Either a b
Left (String -> Either String (Text, Text))
-> String -> Either String (Text, Text)
forall a b. (a -> b) -> a -> b
$ String
"Value " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
v String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" has no key"
(Text
k, Text
v) -> (Text, Text) -> Either String (Text, Text)
forall a b. b -> Either a b
Right (Text
k, Text
v)
splitOnParse :: Char -> Reader e a -> Reader e [a]
splitOnParse :: forall e a. Char -> Reader e a -> Reader e [a]
splitOnParse Char
c Reader e a
p = Reader e a -> [String] -> Either e [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Reader e a
p ([String] -> Either e [a])
-> (String -> Either e [String]) -> String -> Either e [a]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Char -> String -> Either e [String]
forall e. Char -> Reader e [String]
splitOn Char
c
data Timeout
= TimeoutSeconds Int
| TimeoutMilliseconds Int
deriving stock (Int -> Timeout -> String -> String
[Timeout] -> String -> String
Timeout -> String
(Int -> Timeout -> String -> String)
-> (Timeout -> String)
-> ([Timeout] -> String -> String)
-> Show Timeout
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Timeout -> String -> String
showsPrec :: Int -> Timeout -> String -> String
$cshow :: Timeout -> String
show :: Timeout -> String
$cshowList :: [Timeout] -> String -> String
showList :: [Timeout] -> String -> String
Show, Timeout -> Timeout -> Bool
(Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Bool) -> Eq Timeout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Timeout -> Timeout -> Bool
== :: Timeout -> Timeout -> Bool
$c/= :: Timeout -> Timeout -> Bool
/= :: Timeout -> Timeout -> Bool
Eq)
timeout :: Reader Error Timeout
timeout :: Reader Error Timeout
timeout = (String -> Either String Timeout) -> Reader Error Timeout
forall a. (String -> Either String a) -> Reader Error a
eitherReader ((String -> Either String Timeout) -> Reader Error Timeout)
-> (String -> Either String Timeout) -> Reader Error Timeout
forall a b. (a -> b) -> a -> b
$ (String, String) -> Either String Timeout
forall {a} {a}.
(Eq a, IsString a, IsString a) =>
(String, a) -> Either a Timeout
parseTimeout ((String, String) -> Either String Timeout)
-> (String -> (String, String)) -> String -> Either String Timeout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit
where
parseTimeout :: (String, a) -> Either a Timeout
parseTimeout = \case
(String
"", a
_) -> a -> Either a Timeout
forall a b. a -> Either a b
Left a
"must be {digits}(s|ms)"
(String
digits, a
"") -> Timeout -> Either a Timeout
forall a b. b -> Either a b
Right (Timeout -> Either a Timeout) -> Timeout -> Either a Timeout
forall a b. (a -> b) -> a -> b
$ Int -> Timeout
TimeoutSeconds (Int -> Timeout) -> Int -> Timeout
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
Unsafe.read String
digits
(String
digits, a
"s") -> Timeout -> Either a Timeout
forall a b. b -> Either a b
Right (Timeout -> Either a Timeout) -> Timeout -> Either a Timeout
forall a b. (a -> b) -> a -> b
$ Int -> Timeout
TimeoutSeconds (Int -> Timeout) -> Int -> Timeout
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
Unsafe.read String
digits
(String
digits, a
"ms") ->
Timeout -> Either a Timeout
forall a b. b -> Either a b
Right (Timeout -> Either a Timeout) -> Timeout -> Either a Timeout
forall a b. (a -> b) -> a -> b
$ Int -> Timeout
TimeoutMilliseconds (Int -> Timeout) -> Int -> Timeout
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
Unsafe.read String
digits
(String, a)
_ -> a -> Either a Timeout
forall a b. a -> Either a b
Left a
"must be {digits}(s|ms)"