{-# LANGUAGE NamedFieldPuns #-}
module Env.Internal.Help
( helpInfo
, helpDoc
, Info
, ErrorHandler
, defaultInfo
, defaultErrorHandler
, header
, desc
, footer
, handleError
) where
import Data.Foldable (asum)
import qualified Data.List as List
import qualified Data.Map as Map
import Data.Maybe (catMaybes, mapMaybe)
import Data.Ord (comparing)
import Env.Internal.Error (Error)
import qualified Env.Internal.Error as Error
import Env.Internal.Free
import Env.Internal.Parser hiding (Mod)
helpInfo :: Info e -> Parser e b -> [(String, e)] -> String
helpInfo :: Info e -> Parser e b -> [(String, e)] -> String
helpInfo Info {Maybe String
infoHeader :: forall e. Info e -> Maybe String
infoHeader :: Maybe String
infoHeader, Maybe String
infoDesc :: forall e. Info e -> Maybe String
infoDesc :: Maybe String
infoDesc, Maybe String
infoFooter :: forall e. Info e -> Maybe String
infoFooter :: Maybe String
infoFooter, ErrorHandler e
infoHandleError :: forall e. Info e -> ErrorHandler e
infoHandleError :: ErrorHandler e
infoHandleError} Parser e b
p [(String, e)]
errors =
String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"\n\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes
[ Maybe String
infoHeader
, (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"\n" ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [String]
splitWords Int
50) Maybe String
infoDesc
, String -> Maybe String
forall a. a -> Maybe a
Just (Parser e b -> String
forall e a. Parser e a -> String
helpDoc Parser e b
p)
, (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"\n" ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [String]
splitWords Int
50) Maybe String
infoFooter
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ErrorHandler e -> [(String, e)] -> [String]
forall e. ErrorHandler e -> [(String, e)] -> [String]
helpErrors ErrorHandler e
infoHandleError [(String, e)]
errors
helpDoc :: Parser e a -> String
helpDoc :: Parser e a -> String
helpDoc Parser e a
p =
String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"\n" (String
"Available environment variables:\n" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Parser e a -> [String]
forall e a. Parser e a -> [String]
helpParserDoc Parser e a
p)
helpParserDoc :: Parser e a -> [String]
helpParserDoc :: Parser e a -> [String]
helpParserDoc =
[[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String])
-> (Parser e a -> [[String]]) -> Parser e a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String [String] -> [[String]]
forall k a. Map k a -> [a]
Map.elems (Map String [String] -> [[String]])
-> (Parser e a -> Map String [String]) -> Parser e a -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. VarF e a -> Map String [String])
-> Alt (VarF e) a -> Map String [String]
forall p (f :: * -> *) b.
Monoid p =>
(forall a. f a -> p) -> Alt f b -> p
foldAlt (\VarF e a
v -> String -> [String] -> Map String [String]
forall k a. k -> a -> Map k a
Map.singleton (VarF e a -> String
forall e a. VarF e a -> String
varfName VarF e a
v) (VarF e a -> [String]
forall e a. VarF e a -> [String]
helpVarfDoc VarF e a
v)) (Alt (VarF e) a -> Map String [String])
-> (Parser e a -> Alt (VarF e) a)
-> Parser e a
-> Map String [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser e a -> Alt (VarF e) a
forall e a. Parser e a -> Alt (VarF e) a
unParser
helpVarfDoc :: VarF e a -> [String]
helpVarfDoc :: VarF e a -> [String]
helpVarfDoc VarF {String
varfName :: String
varfName :: forall e a. VarF e a -> String
varfName, Maybe String
varfHelp :: forall e a. VarF e a -> Maybe String
varfHelp :: Maybe String
varfHelp, Maybe String
varfHelpDef :: forall e a. VarF e a -> Maybe String
varfHelpDef :: Maybe String
varfHelpDef} =
case Maybe String
varfHelp of
Maybe String
Nothing -> [Int -> String -> String
indent Int
2 String
varfName]
Just String
h
| Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
15 -> Int -> String -> String
indent Int
2 String
varfName String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
indent Int
25) (Int -> String -> [String]
splitWords Int
30 String
t)
| Bool
otherwise ->
case (Int -> String -> String) -> [Int] -> [String] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> String -> String
indent (Int
23 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int -> [Int]
forall a. a -> [a]
repeat Int
25) (Int -> String -> [String]
splitWords Int
30 String
t) of
(String
x : [String]
xs) -> (Int -> String -> String
indent Int
2 String
varfName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
xs
[] -> [Int -> String -> String
indent Int
2 String
varfName]
where k :: Int
k = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
varfName
t :: String
t = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
h (\String
s -> String
h String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (default: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++String
")") Maybe String
varfHelpDef
splitWords :: Int -> String -> [String]
splitWords :: Int -> String -> [String]
splitWords Int
n =
[String] -> Int -> [String] -> [String]
go [] Int
0 ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
where
go :: [String] -> Int -> [String] -> [String]
go [String]
acc Int
_ [] = [String] -> [String]
prep [String]
acc
go [String]
acc Int
k (String
w : [String]
ws)
| Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = [String] -> Int -> [String] -> [String]
go (String
w String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
acc) (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
z) [String]
ws
| Int
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n = [String] -> [String]
prep [String]
acc [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ case Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n String
w of (String
w', String
w'') -> String
w' String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> Int -> [String] -> [String]
go [] Int
0 (String
w'' String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
ws)
| Bool
otherwise = [String] -> [String]
prep [String]
acc [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> Int -> [String] -> [String]
go [String
w] Int
z [String]
ws
where
z :: Int
z = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
w
prep :: [String] -> [String]
prep [] = []
prep [String]
acc = [[String] -> String
unwords ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
acc)]
indent :: Int -> String -> String
indent :: Int -> String -> String
indent Int
n String
s =
Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
helpErrors :: ErrorHandler e -> [(String, e)] -> [String]
helpErrors :: ErrorHandler e -> [(String, e)] -> [String]
helpErrors ErrorHandler e
_ [] = []
helpErrors ErrorHandler e
handler [(String, e)]
fs =
[ String
"Parsing errors:"
, String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"\n" (((String, e) -> Maybe String) -> [(String, e)] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ErrorHandler e -> (String, e) -> Maybe String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ErrorHandler e
handler) (((String, e) -> (String, e) -> Ordering)
-> [(String, e)] -> [(String, e)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (((String, e) -> String) -> (String, e) -> (String, e) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (String, e) -> String
forall e. (String, e) -> String
varName) [(String, e)]
fs))
]
data Info e = Info
{ :: Maybe String
, Info e -> Maybe String
infoDesc :: Maybe String
, :: Maybe String
, Info e -> ErrorHandler e
infoHandleError :: ErrorHandler e
}
type ErrorHandler e = String -> e -> Maybe String
defaultInfo :: Info Error
defaultInfo :: Info Error
defaultInfo = Info :: forall e.
Maybe String
-> Maybe String -> Maybe String -> ErrorHandler e -> Info e
Info
{ infoHeader :: Maybe String
infoHeader = Maybe String
forall a. Maybe a
Nothing
, infoDesc :: Maybe String
infoDesc = Maybe String
forall a. Maybe a
Nothing
, infoFooter :: Maybe String
infoFooter = Maybe String
forall a. Maybe a
Nothing
, infoHandleError :: ErrorHandler Error
infoHandleError = ErrorHandler Error
forall e. (AsUnset e, AsEmpty e, AsUnread e) => ErrorHandler e
defaultErrorHandler
}
header :: String -> Info e -> Info e
String
h Info e
i = Info e
i {infoHeader :: Maybe String
infoHeader=String -> Maybe String
forall a. a -> Maybe a
Just String
h}
desc :: String -> Info e -> Info e
desc :: String -> Info e -> Info e
desc String
h Info e
i = Info e
i {infoDesc :: Maybe String
infoDesc=String -> Maybe String
forall a. a -> Maybe a
Just String
h}
footer :: String -> Info e -> Info e
String
h Info e
i = Info e
i {infoFooter :: Maybe String
infoFooter=String -> Maybe String
forall a. a -> Maybe a
Just String
h}
handleError :: ErrorHandler e -> Info x -> Info e
handleError :: ErrorHandler e -> Info x -> Info e
handleError ErrorHandler e
handler Info x
i = Info x
i {infoHandleError :: ErrorHandler e
infoHandleError=ErrorHandler e
handler}
defaultErrorHandler :: (Error.AsUnset e, Error.AsEmpty e, Error.AsUnread e) => ErrorHandler e
defaultErrorHandler :: ErrorHandler e
defaultErrorHandler String
name e
err =
[Maybe String] -> Maybe String
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [ErrorHandler e
forall e. AsUnset e => ErrorHandler e
handleUnsetError String
name e
err, ErrorHandler e
forall e. AsEmpty e => ErrorHandler e
handleEmptyError String
name e
err, ErrorHandler e
forall e. AsUnread e => ErrorHandler e
handleUnreadError String
name e
err]
handleUnsetError :: Error.AsUnset e => ErrorHandler e
handleUnsetError :: ErrorHandler e
handleUnsetError String
name =
(() -> String) -> Maybe () -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\() -> Int -> String -> String
indent Int
2 (String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is unset")) (Maybe () -> Maybe String) -> (e -> Maybe ()) -> e -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Maybe ()
forall e. AsUnset e => e -> Maybe ()
Error.tryUnset
handleEmptyError :: Error.AsEmpty e => ErrorHandler e
handleEmptyError :: ErrorHandler e
handleEmptyError String
name =
(() -> String) -> Maybe () -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\() -> Int -> String -> String
indent Int
2 (String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is empty")) (Maybe () -> Maybe String) -> (e -> Maybe ()) -> e -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Maybe ()
forall e. AsEmpty e => e -> Maybe ()
Error.tryEmpty
handleUnreadError :: Error.AsUnread e => ErrorHandler e
handleUnreadError :: ErrorHandler e
handleUnreadError String
name =
(String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
val -> Int -> String -> String
indent Int
2 (String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" has value " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
val String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" that cannot be parsed")) (Maybe String -> Maybe String)
-> (e -> Maybe String) -> e -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Maybe String
forall e. AsUnread e => e -> Maybe String
Error.tryUnread
varName :: (String, e) -> String
varName :: (String, e) -> String
varName (String
n, e
_) = String
n