From 9fc7d27fc01540b40dd9e15c7490f25450ed7f09 Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <hexagoxel@hexagoxel.de>
Date: Sun, 20 Sep 2020 14:20:01 +0200
Subject: [PATCH] Add example for butcher+barbies usage

---
 butcher.cabal                          | 11 ++++++--
 examples/BarbieParsing.hs              | 39 ++++++++++++++++++++++++++
 src/UI/Butcher/Internal/Applicative.hs |  2 ++
 src/UI/Butcher/Internal/Monadic.hs     |  2 ++
 4 files changed, 52 insertions(+), 2 deletions(-)
 create mode 100644 examples/BarbieParsing.hs

diff --git a/butcher.cabal b/butcher.cabal
index f187314..785c1bb 100644
--- a/butcher.cabal
+++ b/butcher.cabal
@@ -187,7 +187,6 @@ executable example02
     , butcher
     }
   main-is:          SimpleCommandlineParser.hs
-  other-modules:    
 
 executable example03
   import: example-base
@@ -197,4 +196,12 @@ executable example03
     , concurrent-output
     }
   main-is:          InteractiveConcurrentOutput.hs
-  other-modules:    
+
+executable example04
+  import: example-base
+  build-depends:
+    { base <999
+    , butcher
+    , barbies
+    }
+  main-is:          BarbieParsing.hs
diff --git a/examples/BarbieParsing.hs b/examples/BarbieParsing.hs
new file mode 100644
index 0000000..a231abf
--- /dev/null
+++ b/examples/BarbieParsing.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Main where
+
+import           Barbies
+import           Barbies.Bare
+import           GHC.Generics                   ( Generic )
+import           UI.Butcher.Monadic
+
+
+
+data MyConfig s f = MyConfig
+  { verbosity    :: Wear s f Int
+  , dryRun       :: Wear s f Bool
+  , innerOptions :: Wear s f [String]
+  }
+  deriving Generic
+
+instance BareB MyConfig
+instance FunctorB (MyConfig Covered)
+instance TraversableB (MyConfig Covered)
+
+main :: IO ()
+main = mainFromCmdParser $ do
+
+  reorderStart
+  config <- traverseBarbie MyConfig
+    { verbosity    = addFlagReadParam "v" ["verbosity"] "INT" (flagDefault 1)
+    , dryRun       = addSimpleBoolFlag "" ["dryRun", "dry-run"] mempty
+    , innerOptions = addFlagStringParams "" ["inner-option"] "OPT" mempty
+    }
+  reorderStop
+
+  addCmdImpl $ do
+    putStrLn $ "commandline arguments produced the following config values:"
+    putStrLn $ "verbosity    = " ++ show (verbosity config)
+    putStrLn $ "dryRun       = " ++ show (dryRun config)
+    putStrLn $ "innerOptions = " ++ show (innerOptions config)
+
diff --git a/src/UI/Butcher/Internal/Applicative.hs b/src/UI/Butcher/Internal/Applicative.hs
index 8fa10af..71f30c2 100644
--- a/src/UI/Butcher/Internal/Applicative.hs
+++ b/src/UI/Butcher/Internal/Applicative.hs
@@ -293,6 +293,8 @@ runCmdParserCoreFromDesc input desc parser =
 -- record) then this turns a record whose fields are @CmdParser@s over
 -- different values into a CmdParser that returns a record with the parsed
 -- values in the fields.
+--
+-- See the BarbieParsing example included in this package.
 traverseBarbie
   :: (Barbies.BareB c, Barbies.TraversableB (c Barbies.Covered))
   => c Barbies.Covered (CmdParser out)
diff --git a/src/UI/Butcher/Internal/Monadic.hs b/src/UI/Butcher/Internal/Monadic.hs
index 7a04500..5427ec1 100644
--- a/src/UI/Butcher/Internal/Monadic.hs
+++ b/src/UI/Butcher/Internal/Monadic.hs
@@ -294,6 +294,8 @@ reorderStop = liftF $ CmdParserReorderStop ()
 -- record) then this turns a record whose fields are @CmdParser@s over
 -- different values into a CmdParser that returns a record with the parsed
 -- values in the fields.
+--
+-- See the BarbieParsing example included in this package.
 traverseBarbie
   :: (Barbies.BareB c, Barbies.TraversableB (c Barbies.Covered))
   => c Barbies.Covered (CmdParser f out)