Update examples / Put examples in components
parent
5d67167c87
commit
b4dc827b6e
|
@ -1,8 +1,9 @@
|
||||||
|
cabal-version: 2.2
|
||||||
name: butcher
|
name: butcher
|
||||||
version: 1.3.3.2
|
version: 1.3.3.2
|
||||||
synopsis: Chops a command or program invocation into digestable pieces.
|
synopsis: Chops a command or program invocation into digestable pieces.
|
||||||
description: See the <https://github.com/lspitzner/butcher/blob/master/README.md README> (it is properly formatted on github).
|
description: See the <https://github.com/lspitzner/butcher/blob/master/README.md README> (it is properly formatted on github).
|
||||||
license: BSD3
|
license: BSD-3-Clause
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
author: Lennart Spitzner
|
author: Lennart Spitzner
|
||||||
maintainer: Lennart Spitzner <hexagoxel@hexagoxel.de>
|
maintainer: Lennart Spitzner <hexagoxel@hexagoxel.de>
|
||||||
|
@ -15,7 +16,6 @@ extra-source-files: {
|
||||||
srcinc/prelude.inc
|
srcinc/prelude.inc
|
||||||
README.md
|
README.md
|
||||||
}
|
}
|
||||||
cabal-version: >=1.10
|
|
||||||
homepage: https://github.com/lspitzner/butcher/
|
homepage: https://github.com/lspitzner/butcher/
|
||||||
bug-reports: https://github.com/lspitzner/butcher/issues
|
bug-reports: https://github.com/lspitzner/butcher/issues
|
||||||
|
|
||||||
|
@ -147,3 +147,54 @@ test-suite tests
|
||||||
-fno-warn-unused-imports
|
-fno-warn-unused-imports
|
||||||
-fno-warn-orphans
|
-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:
|
||||||
|
|
24
example2.md
24
example2.md
|
@ -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
|
|
||||||
~~~~
|
|
45
example3.md
45
example3.md
|
@ -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<enter>
|
|
||||||
example interactive commandline program.
|
|
||||||
example> <enter>
|
|
||||||
Usage:
|
|
||||||
exit | greeting
|
|
||||||
example> greeting<enter>
|
|
||||||
hi!
|
|
||||||
example> exit<enter>
|
|
||||||
bash>
|
|
||||||
~~~~
|
|
|
@ -1,6 +1,10 @@
|
||||||
## CmdParser definition
|
module Main where
|
||||||
|
|
||||||
~~~~.hs
|
import UI.Butcher.Monadic
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
main = mainFromCmdParserWithHelpDesc $ \helpDesc -> do
|
main = mainFromCmdParserWithHelpDesc $ \helpDesc -> do
|
||||||
|
|
||||||
addCmdSynopsis "a simple butcher example program"
|
addCmdSynopsis "a simple butcher example program"
|
||||||
|
@ -18,64 +22,10 @@ main = mainFromCmdParserWithHelpDesc $ \helpDesc -> do
|
||||||
|
|
||||||
short <- addSimpleBoolFlag "" ["short"]
|
short <- addSimpleBoolFlag "" ["short"]
|
||||||
(flagHelpStr "make the greeting short")
|
(flagHelpStr "make the greeting short")
|
||||||
name <- addStringParam "NAME"
|
name <- addParamString "NAME"
|
||||||
(paramHelpStr "your name, so you can be greeted properly")
|
(paramHelpStr "your name, so you can be greeted properly")
|
||||||
|
|
||||||
addCmdImpl $ do
|
addCmdImpl $ do
|
||||||
if short
|
if short
|
||||||
then putStrLn $ "hi, " ++ name ++ "!"
|
then putStrLn $ "hi, " ++ name ++ "!"
|
||||||
else putStrLn $ "hello, " ++ name ++ ", welcome from butcher!"
|
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
|
|
||||||
~~~~
|
|
|
@ -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
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue