module Freckle.App.Env
(
Parser
, Off(..)
, On(..)
, parse
, var
, flag
, switch
, handleEither
, str
, auto
, time
, keyValues
, eitherReader
, def
, nonEmpty
) where
import Freckle.App.Prelude
import Control.Error.Util (note)
import Data.String
import Data.Text (pack, unpack)
import qualified Data.Text as T
import Data.Time
import Freckle.App.Env.Internal
import System.Environment (getEnvironment)
import System.Exit (die)
import Text.Read (readEither)
newtype Off a = Off a
newtype On a = On a
parse :: Parser a -> IO a
parse :: Parser a -> IO a
parse Parser a
p = do
[(String, String)]
env <- IO [(String, String)]
getEnvironment
([(String, Error)] -> IO a)
-> (a -> IO a) -> Either [(String, Error)] a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> IO a
forall a. String -> IO a
die (String -> IO a)
-> ([(String, Error)] -> String) -> [(String, Error)] -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, Error)] -> String
prettyErrors) a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [(String, Error)] a -> IO a)
-> Either [(String, Error)] a -> IO a
forall a b. (a -> b) -> a -> b
$ Parser a -> [(String, String)] -> Either [(String, Error)] a
forall a.
Parser a -> [(String, String)] -> Either [(String, Error)] a
unParser Parser a
p [(String, String)]
env
where
prettyErrors :: [(String, Error)] -> String
prettyErrors = [String] -> String
unlines ([String] -> String)
-> ([(String, Error)] -> [String]) -> [(String, Error)] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Error) -> String) -> [(String, Error)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Error -> String) -> (String, Error) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Error -> String
prettyError)
prettyError :: String -> Error -> String
prettyError String
name Error
UnsetError = String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" must be set"
prettyError String
name (InvalidError String
msg) = String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" is invalid:\n " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
msg
var :: Reader a -> String -> Mod a -> Parser a
var :: Reader a -> String -> Mod a -> Parser a
var Reader a
r String
n (Mod Var a -> Var a
m) =
Var a -> Parser a
forall a. Var a -> Parser a
varParser (Var a -> Parser a) -> Var a -> Parser a
forall a b. (a -> b) -> a -> b
$ Var a -> Var a
m Var :: forall a. String -> Reader a -> Maybe a -> Var a
Var { varName :: String
varName = String
n, varReader :: Reader a
varReader = Reader a
r, varDefault :: Maybe a
varDefault = Maybe a
forall a. Maybe a
Nothing }
flag :: Off a -> On a -> String -> Mod a -> Parser a
flag :: Off a -> On a -> String -> Mod a -> Parser a
flag (Off a
f) (On a
t) String
n (Mod Var a -> Var a
m) = Var a -> Parser a
forall a. Var a -> Parser a
varParser (Var a -> Parser a) -> Var a -> Parser a
forall a b. (a -> b) -> a -> b
$ Var a -> Var a
m Var :: forall a. String -> Reader a -> Maybe a -> Var a
Var
{ varName :: String
varName = String
n
, varReader :: Reader a
varReader = (String -> Either Error a) -> Reader a
forall a. (String -> Either Error a) -> Reader a
Reader ((String -> Either Error a) -> Reader a)
-> (String -> Either Error a) -> Reader a
forall a b. (a -> b) -> a -> b
$ \case
String
"" -> a -> Either Error a
forall a b. b -> Either a b
Right a
f
String
_ -> a -> Either Error a
forall a b. b -> Either a b
Right a
t
, varDefault :: Maybe a
varDefault = a -> Maybe a
forall a. a -> Maybe a
Just a
f
}
switch :: String -> Mod Bool -> Parser Bool
switch :: String -> Mod Bool -> Parser Bool
switch = Off Bool -> On Bool -> String -> Mod Bool -> Parser Bool
forall a. Off a -> On a -> String -> Mod a -> Parser a
flag (Bool -> Off Bool
forall a. a -> Off a
Off Bool
False) (Bool -> On Bool
forall a. a -> On a
On Bool
True)
eitherReader :: (String -> Either String a) -> Reader a
eitherReader :: (String -> Either String a) -> Reader a
eitherReader String -> Either String a
f =
(String -> Either Error a) -> Reader a
forall a. (String -> Either Error a) -> Reader a
Reader ((String -> Either Error a) -> Reader a)
-> (String -> Either Error a) -> Reader a
forall a b. (a -> b) -> a -> b
$ \String
s -> (String -> Error) -> Either String a -> Either Error a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Error
InvalidError (String -> Error) -> (String -> String) -> String -> Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String
": \"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\""))) (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
auto :: Read a => Reader a
auto :: Reader a
auto = (String -> Either String a) -> Reader a
forall a. (String -> Either String a) -> Reader a
eitherReader String -> Either String a
forall a. Read a => String -> Either String a
readEither
time :: String -> Reader UTCTime
time :: String -> Reader UTCTime
time String
fmt =
(String -> Either String UTCTime) -> Reader UTCTime
forall a. (String -> Either String a) -> Reader a
eitherReader
((String -> Either String UTCTime) -> Reader UTCTime)
-> (String -> Either String UTCTime) -> Reader 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 [(Text, Text)]
keyValues :: Reader [(Text, Text)]
keyValues = (String -> Either String [(Text, Text)]) -> Reader [(Text, Text)]
forall a. (String -> Either String a) -> Reader a
eitherReader ((String -> Either String [(Text, Text)]) -> Reader [(Text, Text)])
-> (String -> Either String [(Text, Text)])
-> Reader [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ (Text -> Either String (Text, Text))
-> [Text] -> Either String [(Text, Text)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Text -> Either String (Text, Text)
keyValue ([Text] -> Either String [(Text, Text)])
-> (String -> [Text]) -> String -> Either String [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
"," (Text -> [Text]) -> (String -> Text) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack
where
keyValue :: Text -> Either String (Text, Text)
keyValue :: Text -> Either String (Text, Text)
keyValue Text
t = case (Text -> Text) -> (Text, Text) -> (Text, Text)
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)) -> (Text, Text) -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> (Text, Text)
T.breakOn Text
":" Text
t of
(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)
str :: IsString a => Reader a
str :: Reader a
str = (String -> Either Error a) -> Reader a
forall a. (String -> Either Error a) -> Reader a
Reader ((String -> Either Error a) -> Reader a)
-> (String -> Either Error a) -> Reader a
forall a b. (a -> b) -> a -> b
$ a -> Either Error a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either Error a) -> (String -> a) -> String -> Either Error a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
forall a. IsString a => String -> a
fromString
nonEmpty :: Mod a
nonEmpty :: Mod a
nonEmpty = (Var a -> Var a) -> Mod a
forall a. (Var a -> Var a) -> Mod a
Mod ((Var a -> Var a) -> Mod a) -> (Var a -> Var a) -> Mod a
forall a b. (a -> b) -> a -> b
$ \Var a
v -> Var a
v
{ varReader :: Reader a
varReader = (String -> Either Error a) -> Reader a
forall a. (String -> Either Error a) -> Reader a
Reader ((String -> Either Error a) -> Reader a)
-> (String -> Either Error a) -> Reader a
forall a b. (a -> b) -> a -> b
$ \case
[] -> Error -> Either Error a
forall a b. a -> Either a b
Left (Error -> Either Error a) -> Error -> Either Error a
forall a b. (a -> b) -> a -> b
$ String -> Error
InvalidError String
"value cannot be empty"
String
xs -> Reader a -> String -> Either Error a
forall a. Reader a -> String -> Either Error a
unReader (Var a -> Reader a
forall a. Var a -> Reader a
varReader Var a
v) String
xs
}
def :: a -> Mod a
def :: a -> Mod a
def a
d = (Var a -> Var a) -> Mod a
forall a. (Var a -> Var a) -> Mod a
Mod ((Var a -> Var a) -> Mod a) -> (Var a -> Var a) -> Mod a
forall a b. (a -> b) -> a -> b
$ \Var a
v -> Var a
v { varDefault :: Maybe a
varDefault = a -> Maybe a
forall a. a -> Maybe a
Just a
d }
handleEither
:: String
-> Parser (Either String a)
-> Parser a
handleEither :: String -> Parser (Either String a) -> Parser a
handleEither String
context Parser (Either String a)
p = Parser (Either String a)
-> (Either String a -> Parser a) -> Parser a
forall a b. Parser a -> (a -> Parser b) -> Parser b
bindParser Parser (Either String a)
p ((Either String a -> Parser a) -> Parser a)
-> (Either String a -> Parser a) -> Parser a
forall a b. (a -> b) -> a -> b
$ \case
Left String
err -> ([(String, String)] -> Either [(String, Error)] a) -> Parser a
forall a.
([(String, String)] -> Either [(String, Error)] a) -> Parser a
Parser (([(String, String)] -> Either [(String, Error)] a) -> Parser a)
-> ([(String, String)] -> Either [(String, Error)] a) -> Parser a
forall a b. (a -> b) -> a -> b
$ \[(String, String)]
_ -> [(String, Error)] -> Either [(String, Error)] a
forall a b. a -> Either a b
Left [(String
context, String -> Error
InvalidError String
err)]
Right a
x -> a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x