From b4dc827b6ecc4066cff807857d0fd9dffcfd9ffa Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Wed, 9 Sep 2020 00:22:49 +0200 Subject: [PATCH] Update examples / Put examples in components --- butcher.cabal | 55 ++++++++++++++++++- example2.md | 24 --------- example3.md | 45 ---------------- example1.md => examples/HelloWorld.hs | 64 +++------------------- examples/InteractiveConcurrentOutput.hs | 72 +++++++++++++++++++++++++ examples/SimpleCommandlineParser.hs | 27 ++++++++++ 6 files changed, 159 insertions(+), 128 deletions(-) delete mode 100644 example2.md delete mode 100644 example3.md rename example1.md => examples/HelloWorld.hs (51%) create mode 100644 examples/InteractiveConcurrentOutput.hs create mode 100644 examples/SimpleCommandlineParser.hs diff --git a/butcher.cabal b/butcher.cabal index d20b2bb..f187314 100644 --- a/butcher.cabal +++ b/butcher.cabal @@ -1,8 +1,9 @@ +cabal-version: 2.2 name: butcher version: 1.3.3.2 synopsis: Chops a command or program invocation into digestable pieces. description: See the (it is properly formatted on github). -license: BSD3 +license: BSD-3-Clause license-file: LICENSE author: Lennart Spitzner maintainer: Lennart Spitzner @@ -15,7 +16,6 @@ extra-source-files: { srcinc/prelude.inc README.md } -cabal-version: >=1.10 homepage: https://github.com/lspitzner/butcher/ bug-reports: https://github.com/lspitzner/butcher/issues @@ -147,3 +147,54 @@ test-suite tests -fno-warn-unused-imports -fno-warn-orphans } + +common example-base + default-language: Haskell2010 + hs-source-dirs: examples + include-dirs: + srcinc + default-extensions: { + GADTs + + FlexibleContexts + FlexibleInstances + ScopedTypeVariables + MonadComprehensions + LambdaCase + MultiWayIf + KindSignatures + } + ghc-options: { + -Wall + -rtsopts + -fno-warn-unused-imports + -fno-warn-orphans + } + +executable example01 + import: example-base + build-depends: + { base <999 + , butcher + } + main-is: HelloWorld.hs + other-modules: + +executable example02 + import: example-base + build-depends: + { base <999 + , butcher + } + main-is: SimpleCommandlineParser.hs + other-modules: + +executable example03 + import: example-base + build-depends: + { base <999 + , butcher + , concurrent-output + } + main-is: InteractiveConcurrentOutput.hs + other-modules: diff --git a/example2.md b/example2.md deleted file mode 100644 index 57fc460..0000000 --- a/example2.md +++ /dev/null @@ -1,24 +0,0 @@ -## definitions - -~~~~.hs -exampleCmdParser :: CmdParser Identity Int () -exampleCmdParser = do - addCmd "foo" $ addCmdImpl 42 - addCmd "bar" $ addCmdImpl 99 - addCmdImpl 0 - -fooBarParser :: String -> Either ParsingError (CommandDesc Int) -fooBarParser str = result - where - (_desc, result) = - runCmdParser (Just "example") (InputString str) exampleCmdParser -~~~~ - -## Behaviour of fooBarParser: - -~~~~ -fooBarParser "" ~> Right 0 -foobarParser "foo" ~> Right 42 -foobarParser "bar" ~> Right 99 -fooBarParser _ ~> Left someParsingError -~~~~ diff --git a/example3.md b/example3.md deleted file mode 100644 index dc54b63..0000000 --- a/example3.md +++ /dev/null @@ -1,45 +0,0 @@ -## program - -~~~~.hs -data Out = Abort | Continue (IO ()) - -main = do - putStrLn "example interactive commandline program." - loop - where - cmdParser :: CmdParser Identity Out () - cmdParser = do - addCmd "exit" $ addCmdImpl Abort - addCmd "greeting" $ addCmdImpl $ Continue $ putStrLn "hi!" - loop = do - putStr "example> " - hFlush stdout - line <- getLine - case cmdRunParser Nothing (InputString line) cmdParser of - (_, Left err) -> do - print err - loop - (_, Right desc) -> case _cmd_out desc of - Nothing -> do - putStrLn "Usage: " - print $ ppUsage desc - loop - Just Abort -> return () - Just (Continue action) -> do - action - loop -~~~~ - -## sample session: - -~~~~ -bash> ./example -example interactive commandline program. -example> -Usage: -exit | greeting -example> greeting -hi! -example> exit -bash> -~~~~ diff --git a/example1.md b/examples/HelloWorld.hs similarity index 51% rename from example1.md rename to examples/HelloWorld.hs index 668c240..c638af9 100644 --- a/example1.md +++ b/examples/HelloWorld.hs @@ -1,6 +1,10 @@ -## CmdParser definition +module Main where -~~~~.hs +import UI.Butcher.Monadic + + + +main :: IO () main = mainFromCmdParserWithHelpDesc $ \helpDesc -> do addCmdSynopsis "a simple butcher example program" @@ -18,64 +22,10 @@ main = mainFromCmdParserWithHelpDesc $ \helpDesc -> do short <- addSimpleBoolFlag "" ["short"] (flagHelpStr "make the greeting short") - name <- addStringParam "NAME" + name <- addParamString "NAME" (paramHelpStr "your name, so you can be greeted properly") addCmdImpl $ do if short then putStrLn $ "hi, " ++ name ++ "!" else putStrLn $ "hello, " ++ name ++ ", welcome from butcher!" -~~~~ - -## Program behaviour (executable is named `example`): - -~~~~ -> ./example -example: error parsing arguments: could not parse NAME -at the end of input -usage: -example [--short] NAME [version | help] -~~~~ - ---- - -~~~~ -> ./example help -NAME - - example - a simple butcher example program - -USAGE - - example [--short] NAME [version | help] - -DESCRIPTION - - a very long help document - -ARGUMENTS - - --short make the greeting short - NAME your name, so you can be greeted properly -~~~~ - ---- - -~~~~ -> ./example garfield -hello, garfield, welcome from butcher! -~~~~ - ---- - -~~~~ -> ./example --short garfield -hi, garfield! -~~~~ - ---- - -~~~~ -> ./example version --porcelain -1.0 -~~~~ diff --git a/examples/InteractiveConcurrentOutput.hs b/examples/InteractiveConcurrentOutput.hs new file mode 100644 index 0000000..4a773b4 --- /dev/null +++ b/examples/InteractiveConcurrentOutput.hs @@ -0,0 +1,72 @@ +module Main + ( main + ) +where + + +import Data.Char +import Data.Functor.Identity + +import System.Console.Concurrent +import System.Console.Regions +import System.IO + +import UI.Butcher.Monadic + + +parser :: CmdParser Identity (IO ()) () +parser = do + addCmd "inner" $ do + addCmdSynopsis "inner thingy" + my <- addSimpleBoolFlag "" ["my"] mempty + addCmdImpl $ do + putStrLn $ "my = " ++ show my + putStrLn "inner" + addCmd "ither" $ do + addCmdSynopsis "another inner command" + addCmdImpl $ putStrLn "other" + reorderStart + foo <- addSimpleBoolFlag "" ["foo"] (flagHelpStr "!foo help!") + fooo <- addSimpleBoolFlag "" ["fooo"] (flagHelpStr "!fooo help!") + bar <- addSimpleBoolFlag "" ["bar"] (flagHelpStr "!bar is useful!") + x :: Int <- addFlagReadParam "x" [] "X" mempty + _b <- addSimpleBoolFlag "b" [] mempty + reorderStop + addCmdImpl $ do + putStrLn $ "foo = " ++ show foo + putStrLn $ "fooo = " ++ show fooo + putStrLn $ "bar = " ++ show bar + putStrLn $ "x = " ++ show x + +leftToMaybe :: Either a b -> Maybe a +leftToMaybe = either Just (const Nothing) + +main :: IO () +main = displayConsoleRegions $ do + withReg $ \reg1 -> withReg $ \reg2 -> withReg $ \reg3 -> do + let Right desc = toCmdDesc Nothing parser + let mainLoop s = do + let info = runCmdParserFromDesc desc (InputString s) parser + setConsoleRegion reg1 $ show (_ppi_interactiveHelp info 5) + setConsoleRegion reg2 (s ++ _ppi_inputSugg info) + setConsoleRegion reg3 s + -- putStr s + c <- getChar + -- outputConcurrent (show (ord c) ++ "\n") + -- print $ show $ ord + case ord c of + 127 -> do + -- putStr [c] + mainLoop (if null s then s else init s) + 10 -> do + -- putStr (replicate 100 $ chr 127) + mainLoop "" + 27 -> pure () + _ -> do + -- putStr s -- [c] + mainLoop (s ++ [c]) + hSetEcho stdin False + hSetBuffering stdin NoBuffering + hSetBuffering stdout NoBuffering + mainLoop "" + where withReg = withConsoleRegion Linear diff --git a/examples/SimpleCommandlineParser.hs b/examples/SimpleCommandlineParser.hs new file mode 100644 index 0000000..e37ebeb --- /dev/null +++ b/examples/SimpleCommandlineParser.hs @@ -0,0 +1,27 @@ +module Main where + +import UI.Butcher.Monadic + + + +main :: IO () +main = mainFromCmdParser $ do + addCmd "inner" $ do + my <- addSimpleBoolFlag "" ["my"] mempty + addCmdImpl $ do + putStrLn $ "my = " ++ show my + putStrLn "inner" + addCmd "other" $ do + addCmdImpl $ putStrLn "other" + reorderStart + foo <- addSimpleBoolFlag "" ["foo"] mempty + bar <- addSimpleBoolFlag "" ["bar"] mempty + x :: Int <- addFlagReadParam "x" [] "X" mempty + b <- addSimpleBoolFlag "b" [] mempty + reorderStop + addCmdImpl $ do + putStrLn $ "foo = " ++ show foo + putStrLn $ "bar = " ++ show bar + putStrLn $ "x = " ++ show x + putStrLn $ "b = " ++ show b +