diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,11 @@ # Revision history for butcher +## 1.3.2.0 -- October 2018 + +* Fix for simpleCompletion +* Expose some bindings that were forgotten in previous release +* Bounds fixed for ghc-8.6 (also via revision in 1.3.1.1) + ## 1.3.1.1 -- April 2018 * Fixup version bound diff --git a/butcher.cabal b/butcher.cabal --- a/butcher.cabal +++ b/butcher.cabal @@ -1,5 +1,5 @@ name: butcher -version: 1.3.1.1 +version: 1.3.2.0 synopsis: Chops a command or program invocation into digestable pieces. description: See the (it is properly formatted on github). license: BSD3 @@ -38,13 +38,13 @@ UI.Butcher.Monadic.Internal.Core build-depends: { base >=4.9 && <4.12 - , free < 5.1 + , free < 5.2 , unsafe < 0.1 , microlens <0.5 , microlens-th <0.5 , multistate >=0.7 && <0.9 , pretty <1.2 - , containers <0.6 + , containers <0.7 , transformers <0.6 , mtl <2.3 , extra <1.7 diff --git a/src-tests/TestMain.hs b/src-tests/TestMain.hs --- a/src-tests/TestMain.hs +++ b/src-tests/TestMain.hs @@ -121,7 +121,7 @@ describe "completions" $ do it "case 1" $ testCompletion completionTestCmd "" `shouldBe` "" it "case 2" $ testCompletion completionTestCmd "a" `shouldBe` "bc" - it "case 3" $ testCompletion completionTestCmd "abc" `shouldBe` "def" + it "case 3" $ testCompletion completionTestCmd "abc" `shouldBe` "" it "case 4" $ testCompletion completionTestCmd "abc " `shouldBe` "-" it "case 5" $ testCompletion completionTestCmd "abc -" `shouldBe` "" it "case 6" $ testCompletion completionTestCmd "abc --" `shouldBe` "flag" diff --git a/src/UI/Butcher/Monadic.hs b/src/UI/Butcher/Monadic.hs --- a/src/UI/Butcher/Monadic.hs +++ b/src/UI/Butcher/Monadic.hs @@ -1,5 +1,4 @@ --- | Main module of the butcher interface. It reexports everything that is --- exposed in the submodules. +-- | Reexports of everything that is exposed in the submodules. module UI.Butcher.Monadic ( -- * Types Input (..) @@ -18,9 +17,11 @@ , -- * Building CmdParsers module UI.Butcher.Monadic.Command -- * PrettyPrinting CommandDescs (usage/help) - , module UI.Butcher.Monadic.Pretty + , module UI.Butcher.Monadic.Pretty -- * Wrapper around System.Environment.getArgs - , module UI.Butcher.Monadic.IO + , module UI.Butcher.Monadic.IO + -- * Utilities for interactive feedback of commandlines (completions etc.) + , module UI.Butcher.Monadic.Interactive -- , cmds -- , sample -- , test @@ -33,7 +34,10 @@ , addButcherDebugCommand , addShellCompletionCommand , addShellCompletionCommand' + -- * Advanced usage , mapOut + , emptyCommandDesc + , Visibility (..) ) where @@ -48,6 +52,7 @@ import UI.Butcher.Monadic.Internal.Core import UI.Butcher.Monadic.Pretty import UI.Butcher.Monadic.IO +import UI.Butcher.Monadic.Interactive import qualified Text.PrettyPrint as PP diff --git a/src/UI/Butcher/Monadic/Flag.hs b/src/UI/Butcher/Monadic/Flag.hs --- a/src/UI/Butcher/Monadic/Flag.hs +++ b/src/UI/Butcher/Monadic/Flag.hs @@ -93,7 +93,7 @@ instance Monoid (Flag p) where mempty = Flag Nothing Nothing Visible - mappend = appendFlag + mappend = (<>) -- | Create a 'Flag' with just a help text. flagHelp :: PP.Doc -> Flag p diff --git a/src/UI/Butcher/Monadic/Interactive.hs b/src/UI/Butcher/Monadic/Interactive.hs --- a/src/UI/Butcher/Monadic/Interactive.hs +++ b/src/UI/Butcher/Monadic/Interactive.hs @@ -30,11 +30,18 @@ -- subcommand. See 'UI.Butcher.Monadic.runCmdParserExt'. -> String -- ^ completion, i.e. a string that might be appended -- to the current prompt when user presses tab. -simpleCompletion line cdesc pcRest = List.drop (List.length lastWord) - $ longestCommonPrefix choices +simpleCompletion line cdesc pcRest = case reverse line of + [] -> compl + ' ' : _ -> compl + _ | null pcRest -> "" -- necessary to prevent subcommand completion + -- appearing before space that is, if you have command + -- "aaa" with subcommand "sss", we want completion + -- "sss" on "aaa " but not on "aaa". + _ -> compl where + compl = List.drop (List.length lastWord) (longestCommonPrefix choices) longestCommonPrefix [] = "" - longestCommonPrefix (c1:cr) = + longestCommonPrefix (c1 : cr) = case find (\s -> List.all (s `isPrefixOf`) cr) $ reverse $ List.inits c1 of Nothing -> "" Just x -> x diff --git a/src/UI/Butcher/Monadic/Param.hs b/src/UI/Butcher/Monadic/Param.hs --- a/src/UI/Butcher/Monadic/Param.hs +++ b/src/UI/Butcher/Monadic/Param.hs @@ -57,8 +57,8 @@ appendParam :: Param p -> Param p -> Param p appendParam (Param a1 b1 c1) (Param a2 b2 c2) = Param (a1 `f` a2) - (b1 `mappend` b2) - (c1 `mappend` c2) + (b1 <> b2) + (c1 <> c2) where f Nothing x = x f x _ = x @@ -68,7 +68,7 @@ instance Monoid (Param p) where mempty = Param Nothing Nothing Nothing - mappend = appendParam + mappend = (<>) -- | Create a 'Param' with just a help text. paramHelpStr :: String -> Param p diff --git a/src/UI/Butcher/Monadic/Types.hs b/src/UI/Butcher/Monadic/Types.hs --- a/src/UI/Butcher/Monadic/Types.hs +++ b/src/UI/Butcher/Monadic/Types.hs @@ -9,6 +9,7 @@ , ParsingError (..) , PartDesc(..) , emptyCommandDesc + , Visibility (..) ) where diff --git a/srcinc/prelude.inc b/srcinc/prelude.inc --- a/srcinc/prelude.inc +++ b/srcinc/prelude.inc @@ -337,8 +337,9 @@ import Foreign.ForeignPtr ( ForeignPtr ) -import Data.Monoid ( mconcat - , Monoid (..) +import Data.Monoid ( Monoid + , mempty + , mconcat ) import Data.Bifunctor ( bimap )