{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnicodeSyntax #-}
module Configuration.Utils.CommandLine
( MParser
, (.::)
, (%::)
, boolReader
, boolOption
, boolOption_
, enableDisableFlag
, fileOption
, eitherReadP
, jsonOption
, jsonReader
, module Options.Applicative
) where
import Configuration.Utils.Internal
import Configuration.Utils.Operators
import Control.Applicative
import Data.Aeson
import qualified Data.ByteString.Lazy.Char8 as BL8
import qualified Data.CaseInsensitive as CI
import Data.Maybe
import Data.Monoid.Unicode
import Data.String
import qualified Data.Text as T
import Options.Applicative hiding (Parser, Success)
import qualified Options.Applicative.Types as O
import qualified Options.Applicative as O
import qualified Options.Applicative.Builder.Internal as O
import Prelude hiding (any, concatMap, mapM_)
import qualified Text.ParserCombinators.ReadP as P hiding (string)
import Prelude.Unicode hiding ((×))
type MParser a = O.Parser (a → a)
(.::) ∷ (Alternative f, Applicative f) ⇒ Lens' a b → f b → f (a → a)
.:: :: forall (f :: * -> *) a b.
(Alternative f, Applicative f) =>
Lens' a b -> f b -> f (a -> a)
(.::) Lens' a b
a f b
opt = forall a b s t.
((a -> Identity b) -> s -> Identity t) -> b -> s -> t
set Lens' a b
a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
opt forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. a -> a
id
infixr 5 .::
{-# INLINE (.::) #-}
(%::) ∷ (Alternative f, Applicative f) ⇒ Lens' a b → f (b → b) → f (a → a)
%:: :: forall (f :: * -> *) a b.
(Alternative f, Applicative f) =>
Lens' a b -> f (b -> b) -> f (a -> a)
(%::) Lens' a b
a f (b -> b)
opt = forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over Lens' a b
a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (b -> b)
opt forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. a -> a
id
infixr 5 %::
{-# INLINE (%::) #-}
boolReader
∷ (Eq a, Show a, CI.FoldCase a, IsString a, IsString e, Monoid e)
⇒ a
→ Either e Bool
boolReader :: forall a e.
(Eq a, Show a, FoldCase a, IsString a, IsString e, Monoid e) =>
a -> Either e Bool
boolReader a
x = case forall s. FoldCase s => s -> CI s
CI.mk a
x of
CI a
"true" → forall a b. b -> Either a b
Right Bool
True
CI a
"false" → forall a b. b -> Either a b
Right Bool
False
CI a
_ → forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ e
"failed to read Boolean value " forall α. Monoid α => α -> α -> α
⊕ forall a. IsString a => FilePath -> a
fromString (forall a. Show a => a -> FilePath
show a
x)
forall α. Monoid α => α -> α -> α
⊕ e
". Expected either \"true\" or \"false\""
boolOption
∷ O.Mod O.OptionFields Bool
→ O.Parser Bool
boolOption :: Mod OptionFields Bool -> Parser Bool
boolOption Mod OptionFields Bool
mods = forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option (forall a. (FilePath -> Either FilePath a) -> ReadM a
O.eitherReader (forall a e.
(Eq a, Show a, FoldCase a, IsString a, IsString e, Monoid e) =>
a -> Either e Bool
boolReader ∷ String → Either String Bool))
forall a b. (a -> b) -> a -> b
% forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
O.metavar FilePath
"true|false"
forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. HasCompleter f => [FilePath] -> Mod f a
O.completeWith [FilePath
"true", FilePath
"false", FilePath
"TRUE", FilePath
"FALSE", FilePath
"True", FilePath
"False"]
forall α. Monoid α => α -> α -> α
⊕ Mod OptionFields Bool
mods
boolOption_
∷ O.Mod O.FlagFields Bool
→ O.Parser Bool
boolOption_ :: Mod FlagFields Bool -> Parser Bool
boolOption_ Mod FlagFields Bool
mods = forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
True Mod FlagFields Bool
mods forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
False Mod FlagFields Bool
nomods
where
O.Mod FlagFields Bool -> FlagFields Bool
f DefaultProp Bool
d OptProperties -> OptProperties
o = Mod FlagFields Bool
mods
O.FlagFields [OptName]
names Bool
_ = FlagFields Bool -> FlagFields Bool
f forall a b. (a -> b) -> a -> b
$ forall a. [OptName] -> a -> FlagFields a
O.FlagFields [] Bool
False
longName :: OptName -> Maybe FilePath
longName (O.OptShort Char
_) = forall a. Maybe a
Nothing
longName (O.OptLong FilePath
l) = forall a. a -> Maybe a
Just FilePath
l
longNames :: [FilePath]
longNames = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe OptName -> Maybe FilePath
longName [OptName]
names
noName :: α -> α
noName α
l = α
"no-" forall α. Monoid α => α -> α -> α
⊕ α
l
mapFlags :: FlagFields a -> FlagFields a
mapFlags FlagFields a
flags = FlagFields a
flags
{ flagNames :: [OptName]
O.flagNames = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\OptName
l → FilePath -> OptName
O.OptLong forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall {α}. (Monoid α, IsString α) => α -> α
noName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OptName -> Maybe FilePath
longName OptName
l) (forall a. FlagFields a -> [OptName]
O.flagNames FlagFields a
flags)
}
nomods :: Mod FlagFields Bool
nomods = forall (f :: * -> *) a.
(f a -> f a)
-> DefaultProp a -> (OptProperties -> OptProperties) -> Mod f a
O.Mod (forall {a}. FlagFields a -> FlagFields a
mapFlags forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ FlagFields Bool -> FlagFields Bool
f) DefaultProp Bool
d OptProperties -> OptProperties
o
forall α. Monoid α => α -> α -> α
⊕ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\FilePath
l → forall (f :: * -> *) a. FilePath -> Mod f a
help forall a b. (a -> b) -> a -> b
$ FilePath
"unset flag " forall α. Monoid α => α -> α -> α
⊕ FilePath
l) (forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [FilePath]
longNames)
enableDisableFlag
∷ O.Mod O.FlagFields Bool
→ O.Parser Bool
enableDisableFlag :: Mod FlagFields Bool -> Parser Bool
enableDisableFlag Mod FlagFields Bool
mods = forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
True Mod FlagFields Bool
enmods forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
False Mod FlagFields Bool
dismods
where
O.Mod FlagFields Bool -> FlagFields Bool
f DefaultProp Bool
d OptProperties -> OptProperties
o = Mod FlagFields Bool
mods
O.FlagFields [OptName]
names Bool
_ = FlagFields Bool -> FlagFields Bool
f forall a b. (a -> b) -> a -> b
$ forall a. [OptName] -> a -> FlagFields a
O.FlagFields [] Bool
False
longName :: OptName -> Maybe FilePath
longName (O.OptShort Char
_) = forall a. Maybe a
Nothing
longName (O.OptLong FilePath
l) = forall a. a -> Maybe a
Just FilePath
l
longNames :: [FilePath]
longNames = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe OptName -> Maybe FilePath
longName [OptName]
names
disName :: α -> α
disName α
l = α
"disable-" forall α. Monoid α => α -> α -> α
⊕ α
l
enName :: α -> α
enName α
l = α
"enable-" forall α. Monoid α => α -> α -> α
⊕ α
l
mapDisFlags :: FlagFields a -> FlagFields a
mapDisFlags FlagFields a
flags = FlagFields a
flags
{ flagNames :: [OptName]
O.flagNames = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\OptName
l → FilePath -> OptName
O.OptLong forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall {α}. (Monoid α, IsString α) => α -> α
disName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OptName -> Maybe FilePath
longName OptName
l) (forall a. FlagFields a -> [OptName]
O.flagNames FlagFields a
flags)
}
dismods :: Mod FlagFields Bool
dismods = forall (f :: * -> *) a.
(f a -> f a)
-> DefaultProp a -> (OptProperties -> OptProperties) -> Mod f a
O.Mod (forall {a}. FlagFields a -> FlagFields a
mapDisFlags forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ FlagFields Bool -> FlagFields Bool
f) DefaultProp Bool
d OptProperties -> OptProperties
o
forall α. Monoid α => α -> α -> α
⊕ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\FilePath
l → forall (f :: * -> *) a. FilePath -> Mod f a
help forall a b. (a -> b) -> a -> b
$ FilePath
"unset flag " forall α. Monoid α => α -> α -> α
⊕ FilePath
l) (forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [FilePath]
longNames)
mapLong :: (FilePath -> FilePath) -> OptName -> OptName
mapLong FilePath -> FilePath
g (O.OptLong FilePath
l) = FilePath -> OptName
O.OptLong (FilePath -> FilePath
g FilePath
l)
mapLong FilePath -> FilePath
_ OptName
s = OptName
s
mapEnFlags :: FlagFields a -> FlagFields a
mapEnFlags FlagFields a
flags = FlagFields a
flags
{ flagNames :: [OptName]
O.flagNames = forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> FilePath) -> OptName -> OptName
mapLong forall {α}. (Monoid α, IsString α) => α -> α
enName) (forall a. FlagFields a -> [OptName]
O.flagNames FlagFields a
flags)
}
enmods :: Mod FlagFields Bool
enmods = forall (f :: * -> *) a.
(f a -> f a)
-> DefaultProp a -> (OptProperties -> OptProperties) -> Mod f a
O.Mod (forall {a}. FlagFields a -> FlagFields a
mapEnFlags forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ FlagFields Bool -> FlagFields Bool
f) DefaultProp Bool
d OptProperties -> OptProperties
o
fileOption
∷ O.Mod O.OptionFields String
→ O.Parser FilePath
fileOption :: Mod OptionFields FilePath -> Parser FilePath
fileOption Mod OptionFields FilePath
mods = forall s. IsString s => Mod OptionFields s -> Parser s
O.strOption
forall a b. (a -> b) -> a -> b
% forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
O.metavar FilePath
"FILE"
forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
O.action FilePath
"file"
forall α. Monoid α => α -> α -> α
⊕ Mod OptionFields FilePath
mods
eitherReadP
∷ T.Text
→ P.ReadP a
→ T.Text
→ Either T.Text a
eitherReadP :: forall a. Text -> ReadP a -> Text -> Either Text a
eitherReadP Text
label ReadP a
p Text
s =
case [ a
x | (a
x,FilePath
"") ← forall a. ReadP a -> ReadS a
P.readP_to_S ReadP a
p (Text -> FilePath
T.unpack Text
s) ] of
[a
x] → forall a b. b -> Either a b
Right a
x
[] → forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"eitherReadP: no parse for " forall α. Monoid α => α -> α -> α
⊕ Text
label forall α. Monoid α => α -> α -> α
⊕ Text
" of " forall α. Monoid α => α -> α -> α
⊕ Text
s
[a]
_ → forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"eitherReadP: ambigous parse for " forall α. Monoid α => α -> α -> α
⊕ Text
label forall α. Monoid α => α -> α -> α
⊕ Text
" of " forall α. Monoid α => α -> α -> α
⊕ Text
s
jsonOption ∷ FromJSON a ⇒ Mod OptionFields a → O.Parser a
jsonOption :: forall a. FromJSON a => Mod OptionFields a -> Parser a
jsonOption = forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option forall a. FromJSON a => ReadM a
jsonReader
jsonReader ∷ FromJSON a ⇒ ReadM a
jsonReader :: forall a. FromJSON a => ReadM a
jsonReader = forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Either FilePath a
eitherDecode' forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ FilePath -> ByteString
BL8.pack