{-# LANGUAGE NamedFieldPuns #-}
module Env.Internal.Help
  ( helpInfo
  , helpDoc
  , Info
  , ErrorHandler
  , defaultInfo
  , defaultErrorHandler
  , header
  , desc
  , footer
  , widthMax
  , 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 :: forall e b. Info e -> Parser e b -> [(String, e)] -> String
helpInfo Info {Maybe String
infoHeader :: Maybe String
infoHeader :: forall e. Info e -> Maybe String
infoHeader, Maybe String
infoDesc :: Maybe String
infoDesc :: forall e. Info e -> Maybe String
infoDesc, Maybe String
infoFooter :: Maybe String
infoFooter :: forall e. Info e -> Maybe String
infoFooter, ErrorHandler e
infoHandleError :: ErrorHandler e
infoHandleError :: forall e. Info e -> ErrorHandler e
infoHandleError, Int
infoWidthMax :: Int
infoWidthMax :: forall e. Info e -> Int
infoWidthMax} 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 a b. (a -> b) -> Maybe a -> Maybe b
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
infoWidthMax) Maybe String
infoDesc
    , String -> Maybe String
forall a. a -> Maybe a
Just (Int -> Parser e b -> String
forall e a. Int -> Parser e a -> String
helpDoc Int
infoWidthMax Parser e b
p)
    , (String -> String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
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
infoWidthMax) 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 :: Int -> Parser e a -> String
helpDoc :: forall e a. Int -> Parser e a -> String
helpDoc Int
widthMax 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]
: Int -> Parser e a -> [String]
forall e a. Int -> Parser e a -> [String]
helpParserDoc Int
widthMax Parser e a
p)

helpParserDoc :: Int -> Parser e a -> [String]
helpParserDoc :: forall e a. Int -> Parser e a -> [String]
helpParserDoc Int
widthMax =
  [[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) (Int -> VarF e a -> [String]
forall e a. Int -> VarF e a -> [String]
helpVarfDoc Int
widthMax 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 :: Int -> VarF e a -> [String]
helpVarfDoc :: forall e a. Int -> VarF e a -> [String]
helpVarfDoc Int
widthMax VarF {String
varfName :: forall e a. VarF e a -> String
varfName :: String
varfName, Maybe String
varfHelp :: Maybe String
varfHelp :: forall e a. VarF e a -> Maybe String
varfHelp, Maybe String
varfHelpDef :: Maybe String
varfHelpDef :: forall e a. VarF e a -> Maybe String
varfHelpDef} =
  case Maybe String
varfHelp of
    Maybe String
Nothing -> [Int -> String -> String
indent Int
vo String
varfName]
    Just String
h
      | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
nameWidthMax ->
          Int -> String -> String
indent Int
vo 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
ho) (Int -> String -> [String]
splitWords (Int
widthMax Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ho) 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
ho Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
vo 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
ho) (Int -> String -> [String]
splitWords (Int
widthMax Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ho) String
t) of
            (String
x : [String]
xs) -> (Int -> String -> String
indent Int
vo 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
vo String
varfName]
     where
      k :: Int
k = String -> Int
forall a. [a] -> 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
 where
  -- The longest variable name that fits the compact view.
  nameWidthMax :: Int
nameWidthMax = Int
ho Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
vo Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 {- the space between the variable name and the help text -}
  vo :: Int
vo = Int
2  -- variable name offset
  ho :: Int
ho = Int
25 -- help text offset

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 a. [a] -> 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 :: forall e. 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
  { forall e. Info e -> Maybe String
infoHeader      :: Maybe String
  , forall e. Info e -> Maybe String
infoDesc        :: Maybe String
  , forall e. Info e -> Maybe String
infoFooter      :: Maybe String
  , forall e. Info e -> ErrorHandler e
infoHandleError :: ErrorHandler e
  , forall e. Info e -> Int
infoWidthMax    :: Int
  }

-- | 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
  { 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
  , infoWidthMax :: Int
infoWidthMax = Int
80
  }

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

-- | Set the short description
desc :: String -> Info e -> Info e
desc :: forall e. String -> Info e -> Info e
desc String
h Info e
i = Info e
i {infoDesc=Just h}

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

-- | Set the max info width.
--
-- /Note:/ It will be set to 26 columns if a smaller value is passed.
widthMax :: Int -> Info e -> Info e
widthMax :: forall e. Int -> Info e -> Info e
widthMax Int
n Info e
i = Info e
i {infoWidthMax=max 26 n}

-- | An error handler
handleError :: ErrorHandler e -> Info x -> Info e
handleError :: forall e x. ErrorHandler e -> Info x -> Info e
handleError ErrorHandler e
handler Info x
i = Info x
i {infoHandleError=handler}

-- | The default error handler
defaultErrorHandler :: (Error.AsUnset e, Error.AsEmpty e, Error.AsUnread e) => ErrorHandler e
defaultErrorHandler :: forall e. (AsUnset e, AsEmpty e, AsUnread e) => 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 :: forall e. AsUnset e => ErrorHandler e
handleUnsetError String
name =
  (() -> String) -> Maybe () -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
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 :: forall e. AsEmpty e => ErrorHandler e
handleEmptyError String
name =
  (() -> String) -> Maybe () -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
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 :: forall e. AsUnread e => ErrorHandler e
handleUnreadError String
name =
  (String -> String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
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 :: forall e. (String, e) -> String
varName (String
n, e
_) = String
n