Skip to content

Commit

Permalink
fix #14: Implement maximum info width setting
Browse files Browse the repository at this point in the history
  • Loading branch information
supki committed Jun 14, 2022
1 parent 503a699 commit 5960149
Show file tree
Hide file tree
Showing 3 changed files with 69 additions and 19 deletions.
33 changes: 33 additions & 0 deletions example/CustomInfoWidth.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,33 @@
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
-- | Custom info width example.
module Main (main) where

import Env
import System.Environment (getArgs)
import Text.Read (readMaybe)


main :: IO ()
main = do
(readMaybe -> Just widthMax) : _ <- getArgs
_ <- hello widthMax
error "impossible"

hello :: Int -> IO ()
hello n = Env.parse (header "envparse example" . Env.widthMax n) $ do
_ <- var (str @String) "NAME" (help loremIpsum)
_ <- var (str @String) "A_NAME_THAT_DOESN'T_FIT_IN_THE_COMPACT_VIEW" (help loremIpsum)
pure ()

loremIpsum :: String
loremIpsum =
"Lorem ipsum dolor sit amet, consectetur adipiscing elit, \
\sed do eiusmod tempor incididunt ut labore et dolore magna \
\aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco \
\laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure \
\dolor in reprehenderit in voluptate velit esse cillum dolore eu \
\fugiat nulla pariatur. Excepteur sint occaecat cupidatat non \
\proident, sunt in culpa qui officia deserunt mollit anim id est \
\laborum."
1 change: 1 addition & 0 deletions src/Env.hs
Original file line number Diff line number Diff line change
Expand Up @@ -51,6 +51,7 @@ module Env
, Help.header
, Help.desc
, Help.footer
, Help.widthMax
, Help.handleError
, Help.ErrorHandler
, Help.defaultErrorHandler
Expand Down
54 changes: 35 additions & 19 deletions src/Env/Internal/Help.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@ module Env.Internal.Help
, header
, desc
, footer
, widthMax
, handleError
) where

Expand All @@ -25,35 +26,42 @@ import Env.Internal.Parser hiding (Mod)


helpInfo :: Info e -> Parser e b -> [(String, e)] -> String
helpInfo Info {infoHeader, infoDesc, infoFooter, infoHandleError} p errors =
helpInfo Info {infoHeader, infoDesc, infoFooter, infoHandleError, infoWidthMax} p errors =
List.intercalate "\n\n" $ catMaybes
[ infoHeader
, fmap (List.intercalate "\n" . splitWords 50) infoDesc
, Just (helpDoc p)
, fmap (List.intercalate "\n" . splitWords 50) infoFooter
, fmap (List.intercalate "\n" . splitWords infoWidthMax) infoDesc
, Just (helpDoc infoWidthMax p)
, fmap (List.intercalate "\n" . splitWords infoWidthMax) infoFooter
] ++ helpErrors infoHandleError errors

-- | A pretty-printed list of recognized environment variables suitable for usage messages
helpDoc :: Parser e a -> String
helpDoc p =
List.intercalate "\n" ("Available environment variables:\n" : helpParserDoc p)
helpDoc :: Int -> Parser e a -> String
helpDoc widthMax p =
List.intercalate "\n" ("Available environment variables:\n" : helpParserDoc widthMax p)

helpParserDoc :: Parser e a -> [String]
helpParserDoc =
concat . Map.elems . foldAlt (\v -> Map.singleton (varfName v) (helpVarfDoc v)) . unParser
helpParserDoc :: Int -> Parser e a -> [String]
helpParserDoc widthMax =
concat . Map.elems . foldAlt (\v -> Map.singleton (varfName v) (helpVarfDoc widthMax v)) . unParser

helpVarfDoc :: VarF e a -> [String]
helpVarfDoc VarF {varfName, varfHelp, varfHelpDef} =
helpVarfDoc :: Int -> VarF e a -> [String]
helpVarfDoc widthMax VarF {varfName, varfHelp, varfHelpDef} =
case varfHelp of
Nothing -> [indent 2 varfName]
Nothing -> [indent vo varfName]
Just h
| k > 15 -> indent 2 varfName : map (indent 25) (splitWords 30 t)
| k > nameWidthMax ->
indent vo varfName : map (indent ho) (splitWords (widthMax - ho) t)
| otherwise ->
case zipWith indent (23 - k : repeat 25) (splitWords 30 t) of
(x : xs) -> (indent 2 varfName ++ x) : xs
[] -> [indent 2 varfName]
where k = length varfName
t = maybe h (\s -> h ++ " (default: " ++ s ++")") varfHelpDef
case zipWith indent (ho - vo - k : repeat ho) (splitWords (widthMax - ho) t) of
(x : xs) -> (indent vo varfName ++ x) : xs
[] -> [indent vo varfName]
where
k = length varfName
t = maybe h (\s -> h ++ " (default: " ++ s ++")") varfHelpDef
where
-- The longest variable name that fits the compact view.
nameWidthMax = ho - vo - 1 {- the space between the variable name and the help text -}
vo = 2 -- variable name offset
ho = 25 -- help text offset

splitWords :: Int -> String -> [String]
splitWords n =
Expand Down Expand Up @@ -87,6 +95,7 @@ data Info e = Info
, infoDesc :: Maybe String
, infoFooter :: Maybe String
, infoHandleError :: ErrorHandler e
, infoWidthMax :: Int
}

-- | Given a variable name and an error value, try to produce a useful error message
Expand All @@ -98,6 +107,7 @@ defaultInfo = Info
, infoDesc = Nothing
, infoFooter = Nothing
, infoHandleError = defaultErrorHandler
, infoWidthMax = 80
}

-- | Set the help text header (it usually includes the application's name and version)
Expand All @@ -112,6 +122,12 @@ desc h i = i {infoDesc=Just h}
footer :: String -> Info e -> Info e
footer h i = 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 n i = i {infoWidthMax=max 26 n}

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

4 comments on commit 5960149

@ocharles
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

FYI this was a breaking change, so we should really be at 0.6 now

@supki
Copy link
Owner Author

@supki supki commented on 5960149 Aug 13, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

(I'm assuming you're referring to helpDoc changing its type, if not please elaborate!) Yeah, my bad, I wasn't paying enough attention to versioning here.

@ocharles
Copy link

@ocharles ocharles commented on 5960149 Aug 13, 2024 via email

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@supki
Copy link
Owner Author

@supki supki commented on 5960149 Aug 14, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Oh, no, you weren't rude; it's just that the code is 2 years old and I don't really keep envparse's source in my head too much, so I was a bit unsure if I identified the problem correctly. I'll make sure to push 0.6 today. 👍

Please sign in to comment.