core-program 0.4.5.1 → 0.4.5.3
raw patch · 4 files changed
+39/−34 lines, 4 filesdep ~core-datadep ~core-textPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: core-data, core-text
API changes (from Hackage documentation)
Files
- core-program.cabal +3/−3
- lib/Core/Program/Arguments.hs +24/−16
- lib/Core/Program/Execute.hs +1/−1
- lib/Core/Program/Metadata.hs +11/−14
core-program.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: core-program-version: 0.4.5.1+version: 0.4.5.3 synopsis: Opinionated Haskell Interoperability description: A library to help build command-line programs, both tools and longer-running daemons.@@ -58,8 +58,8 @@ , base >=4.11 && <5 , bytestring , chronologique- , core-data >=0.2.1.11- , core-text >=0.3.4.0+ , core-data >=0.3.2.2+ , core-text >=0.3.7.0 , directory , exceptions , filepath
lib/Core/Program/Arguments.hs view
@@ -706,11 +706,11 @@ extractValidModes :: [Commands] -> Map LongName [Options] extractValidModes commands =- foldr k emptyMap commands+ List.foldl' k emptyMap commands where- k :: Commands -> Map LongName [Options] -> Map LongName [Options]- k (Command longname _ options) modes = insertKeyValue longname options modes- k _ modes = modes+ k :: Map LongName [Options] -> Commands -> Map LongName [Options]+ k modes (Command longname _ options) = insertKeyValue longname options modes+ k modes _ = modes {- | Break the command-line apart in two steps. The first peels off the global@@ -771,14 +771,14 @@ -- The code from here on is formatting code. It's fairly repetative -- and crafted to achieve a specific aesthetic output. Rather messy. -- I'm sure it could be done "better" but no matter; this is on the--- path to an exit and return to user's command line.+-- path to an exit and return to user's shell prompt. -- buildUsage :: Config -> Maybe LongName -> Doc ann buildUsage config mode = case config of Blank -> emptyDoc Simple options ->- let (o, a) = partitionParameters options+ let (o, a, v) = partitionParameters options in "Usage:" <> hardline <> hardline <> indent 4@@ -797,11 +797,13 @@ <> formatParameters o <> argumentsHeading a <> formatParameters a+ <> variablesHeading v+ <> formatParameters v Complex commands -> let globalOptions = extractGlobalOptions commands modes = extractValidModes commands - (oG, _) = partitionParameters globalOptions+ (oG, _, vG) = partitionParameters globalOptions in "Usage:" <> hardline <> hardline <> case mode of Nothing -> indent@@ -820,8 +822,10 @@ <> formatParameters oG <> commandHeading modes <> formatCommands commands+ <> variablesHeading vG+ <> formatParameters vG Just longname ->- let (oL, aL) = case lookupKeyValue longname modes of+ let (oL, aL, vL) = case lookupKeyValue longname modes of Just localOptions -> partitionParameters localOptions Nothing -> error "Illegal State" in indent@@ -843,9 +847,11 @@ <> formatParameters oL <> argumentsHeading aL <> formatParameters aL+ <> variablesHeading vL+ <> formatParameters vL where- partitionParameters :: [Options] -> ([Options], [Options])- partitionParameters options = foldr f ([], []) options+ partitionParameters :: [Options] -> ([Options], [Options], [Options])+ partitionParameters options = List.foldl' f ([], [], []) options optionsSummary :: [Options] -> Doc ann optionsSummary os = if length os > 0 then softline <> "[OPTIONS]" else emptyDoc@@ -874,6 +880,8 @@ argumentsHeading as = if length as > 0 then hardline <> "Required arguments:" <> hardline else emptyDoc + variablesHeading vs = if length vs > 0 then hardline <> "Known environment variables:" <> hardline else emptyDoc+ remainingSummary :: [Options] -> Doc ann remainingSummary as = if hasRemaining as then " ..." else emptyDoc @@ -881,11 +889,11 @@ commandSummary modes = if length modes > 0 then softline <> commandName else emptyDoc commandHeading modes = if length modes > 0 then hardline <> "Available commands:" <> hardline else emptyDoc - f :: Options -> ([Options], [Options]) -> ([Options], [Options])- f o@(Option _ _ _ _) (opts, args) = (o : opts, args)- f a@(Argument _ _) (opts, args) = (opts, a : args)- f a@(Remaining _) (opts, args) = (opts, a : args)- f (Variable _ _) (opts, args) = (opts, args)+ f :: ([Options], [Options], [Options]) -> Options -> ([Options], [Options], [Options])+ f (opts, args, vars) o@(Option _ _ _ _) = (o : opts, args, vars)+ f (opts, args, vars) a@(Argument _ _) = (opts, a : args, vars)+ f (opts, args, vars) a@(Remaining _) = (opts, a : args, vars)+ f (opts, args, vars) v@(Variable _ _) = (opts, args, v : vars) formatParameters :: [Options] -> Doc ann formatParameters [] = emptyDoc@@ -931,7 +939,7 @@ h acc (Command longname description _) = let l = pretty longname d = fromRope description- in fillBreak 16 (" " <> l <> " ") <+> align (reflow d) <> hardline <> acc+ in acc <> fillBreak 16 (" " <> l <> " ") <+> align (reflow d) <> hardline h acc _ = acc buildVersion :: Version -> Doc ann
lib/Core/Program/Execute.hs view
@@ -826,7 +826,7 @@ @ program = do- overwrite \<- 'queryOptionValue' \"overwrite\"+ overwrite \<- 'queryOptionFlag' \"overwrite\" ... @
lib/Core/Program/Metadata.hs view
@@ -25,7 +25,6 @@ import Core.System.Base (IOMode (..), withFile) import Core.System.Pretty import Core.Text-import Data.List (intersperse) import qualified Data.List as List (find, isSuffixOf) import Data.Maybe (fromMaybe) import Data.String@@ -148,23 +147,21 @@ -- pass to calling program return pairs +-- TODO this could be improved; we really only need the data from the first+-- block of lines, with colons in them! We're probably reached the point where+-- a proper parser would be good, but whatever. parseCabalFile :: Bytes -> Map Rope Rope parseCabalFile contents =- let breakup = intoMap . fmap (breakRope (== ':')) . breakLines . fromBytes+ let breakup = intoMap . fmap (\(a, b) -> (a, trimValue b)) . fmap (breakRope (== ':')) . breakLines . fromBytes in breakup contents --- this should probably be a function in Core.Text.Rope-breakRope :: (Char -> Bool) -> Rope -> (Rope, Rope)-breakRope predicate text =- let pieces = take 2 (breakPieces predicate text)- in case pieces of- [] -> ("", "")- [one] -> (one, "")- (one : two : _) -> (one, trimRope two)---- knock off the whitespace in "name: hello"-trimRope :: Rope -> Rope-trimRope = mconcat . intersperse " " . breakWords+-- knock off the colon and whitespace in ": hello"+trimValue :: Rope -> Rope+trimValue value = case unconsRope value of+ Nothing -> emptyRope+ Just (_, remainder) -> case findIndexRope (/= ' ') remainder of+ Nothing -> emptyRope+ Just i -> snd (splitRope i remainder) {- | Access the source location of the call site.