From b2435e1e37b9def481761a00c704d280ef2deb96 Mon Sep 17 00:00:00 2001
From: defanor <defanor@uberspace.net>
Date: Wed, 20 Dec 2017 10:12:52 +0300
Subject: Remove Coalpit.IO

Better to focus on printing and parsing here, at least for now;
besides, pipes are nice, but some may prefer other methods.

The code is moved into an example instead.
---
 examples/Basic.hs | 45 +++++++++++++++++++++++++++++++++++++
 examples/Pipes.hs | 66 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 111 insertions(+)
 create mode 100644 examples/Basic.hs
 create mode 100644 examples/Pipes.hs

(limited to 'examples')

diff --git a/examples/Basic.hs b/examples/Basic.hs
new file mode 100644
index 0000000..a08730d
--- /dev/null
+++ b/examples/Basic.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
+module Main where
+
+import GHC.Generics
+import Coalpit
+import Data.Proxy
+
+data FooArgs = FooArgs { arg1 :: Int
+                       , arg2 :: String
+                       } deriving (Show, Generic, Coalpit)
+
+data FooBar = Foo FooArgs
+            | Bar
+            deriving (Show, Generic, Coalpit)
+
+data Input = Input { something :: Maybe String
+                   , fooBar :: Maybe FooBar
+                   , fooBar2 :: FooBar
+                   } deriving (Show, Generic, Coalpit)
+
+main :: IO ()
+main = do
+  let val = Input { something = Nothing
+                  , fooBar = Just (Foo FooArgs { arg1 = 1
+                                               , arg2 = "a string"})
+                  , fooBar2 = Bar}
+      args = toArgs defOpt val
+  print val
+  print args
+  print (fromArgs defOpt args :: Either String Input)
+
+data Test = Test { foo :: [Int], bar :: Maybe String }
+  deriving (Show, Generic, Coalpit)
+
+help :: IO ()
+help = do
+  mapM_ (\(o, x, y) -> print o >> putStrLn x >> putStrLn y) $
+    [ let opts = defOpt { alwaysUseSelName = ausn
+                        , omitNamedOptions = ono }
+      in ( (ausn, ono)
+         , showDSV opts [Test [1,2,3] vals]
+         , argHelper opts [] (Proxy :: Proxy Test))
+      | ausn <- [True, False]
+      , ono <- [True, False]
+      , vals <- [Just "a string", Nothing]]
diff --git a/examples/Pipes.hs b/examples/Pipes.hs
new file mode 100644
index 0000000..7b50f93
--- /dev/null
+++ b/examples/Pipes.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE RankNTypes, ScopedTypeVariables, DeriveGeneric,
+  DeriveAnyClass #-}
+
+module Coalpit.IO (runMain, runMain', handleErrors) where
+
+import Data.Proxy (Proxy(..))
+import System.Environment (getProgName, getArgs)
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import System.Exit (die)
+import System.IO (hPutStrLn, stderr)
+import Pipes ((>->), Pipe, yield, await, lift, runEffect)
+import Control.Monad (mapM_, forever)
+import qualified Pipes.Prelude as PP
+import Coalpit.Core (Coalpit, fromArgs, defOpt, usage)
+import Coalpit.DSV (readDSV, showDSV)
+import GHC.Generics
+
+-- | Runs a given action on each 'Left' value, embedding that action's
+-- result into the data stream.
+handleErrors :: MonadIO m => (e -> m [a]) -> Pipe (Either e a) a m ()
+handleErrors e = forever $ do
+  v <- await
+  case v of
+    Left err -> do
+      vs <- lift $ e err
+      mapM_ yield vs
+    Right x -> yield x
+
+-- | Runs a given 'Pipe' between input producer and output consumer.
+-- Prints an error and usage instructions if it fails to parse the
+-- arguments, and passes the input through 'handleErrors'.
+runMain :: forall m a i o. (MonadIO m, Coalpit a, Coalpit i, Coalpit o)
+        => (String -> m [i])
+        -- ^ An action to run on error (see 'handleErrors').
+        -> (a -> Pipe i o m ())
+        -- ^ Main function.
+        -> m ()
+runMain e f = do
+  pn <- liftIO getProgName
+  let u = Prelude.concat ["Usage: ", pn, " ", usage defOpt (Proxy :: Proxy a)]
+  args <- liftIO getArgs
+  a <- either (liftIO . die . (++ u)) pure $ fromArgs defOpt args
+  runEffect $
+    PP.stdinLn
+    >-> PP.map (readDSV defOpt)
+    >-> handleErrors e
+    >-> f a
+    >-> PP.map (showDSV defOpt)
+    >-> PP.stdoutLn
+
+-- | Same as 'runMain', but just prints errors into 'stderr'.
+runMain' :: forall m a i o. (MonadIO m, Coalpit a, Coalpit i, Coalpit o)
+         => (a -> Pipe i o m ())
+         -- ^ Main function.
+         -> m ()
+runMain' = runMain (\e -> liftIO $ hPutStrLn stderr e >> pure [])
+
+
+data Args = Args { arg1 :: Maybe Int, arg2 :: Double }
+  deriving (Generic, Coalpit)
+data Input = Input Double deriving (Generic, Coalpit)
+data Output = Foo Double | Bar deriving (Generic, Coalpit)
+
+main :: IO ()
+main = runMain' $ \a -> PP.mapM $ \(Input i) ->
+  pure $ Foo $ maybe (arg2 a) fromIntegral (arg1 a) + i
-- 
cgit v1.2.3