{-# 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

-- | A pretty-printed list of recognized environment variables suitable for usage messages
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))
  ]

-- | Parser's metadata
data Info e = Info
  { Info e -> Maybe String
infoHeader      :: Maybe String
  , Info e -> Maybe String
infoDesc        :: Maybe String
  , Info e -> Maybe String
infoFooter      :: Maybe String
  , Info e -> ErrorHandler e
infoHandleError :: ErrorHandler e
  }

-- | Given a variable name and an error value, try to produce a useful error message
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
  }

-- | Set the help text header (it usually includes the application's name and version)
header :: String -> Info e -> Info e
header :: String -> Info e -> Info e
header String
h Info e
i = Info e
i {infoHeader :: Maybe String
infoHeader=String -> Maybe String
forall a. a -> Maybe a
Just String
h}

-- | Set the short description
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}

-- | Set the help text footer (it usually includes examples)
footer :: String -> Info e -> Info e
footer :: String -> Info e -> Info e
footer String
h Info e
i = Info e
i {infoFooter :: Maybe String
infoFooter=String -> Maybe String
forall a. a -> Maybe a
Just String
h}

-- | An error handler
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}

-- | The default error 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