summaryrefslogtreecommitdiff
path: root/examples
diff options
context:
space:
mode:
authordefanor <defanor@uberspace.net>2024-01-27 23:04:26 +0300
committerdefanor <defanor@uberspace.net>2024-01-27 23:04:26 +0300
commit788de39262809040ebf1096aff22190ad526dc1b (patch)
treeb8a3a659821aac623b6232728e2d3b80cebbe335 /examples
parentb09a00426c4f72892f7863bbaaf688c21592dd03 (diff)
Rewrite, version 0.2: use Parsec, focus on DSV
Diffstat (limited to 'examples')
-rw-r--r--examples/Basic.hs16
-rw-r--r--examples/Pipes.hs67
2 files changed, 7 insertions, 76 deletions
diff --git a/examples/Basic.hs b/examples/Basic.hs
index 13ee95d..60306ca 100644
--- a/examples/Basic.hs
+++ b/examples/Basic.hs
@@ -24,10 +24,10 @@ main = do
, fooBar = Just (Foo FooArgs { arg1 = 1
, arg2 = "a string"})
, fooBar2 = Bar}
- args = toArgs defOpt val
+ dsv = toDSV defOpt val
print val
- print args
- print (fromArgs defOpt args :: Either String Input)
+ print dsv
+ print (fromDSV defOpt dsv :: Either String Input)
data Test = Test { foo :: [Int], bar :: Maybe String }
deriving (Show, Generic, Coalpit)
@@ -35,11 +35,9 @@ data Test = Test { foo :: [Int], bar :: Maybe String }
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)
+ [ let opts = defOpt { selNamePolicy = snpol }
+ in ( snpol
+ , toDSV opts (Test [1,2,3] vals)
, usageString opts (Proxy :: Proxy Test))
- | ausn <- [True, False]
- , ono <- [True, False]
+ | snpol <- [SNDisable, SNAvoid, SNPrefer, SNRequire]
, vals <- [Just "a string", Nothing]]
diff --git a/examples/Pipes.hs b/examples/Pipes.hs
deleted file mode 100644
index b1096e3..0000000
--- a/examples/Pipes.hs
+++ /dev/null
@@ -1,67 +0,0 @@
-{-# 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, " "
- , usageString 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