From 788de39262809040ebf1096aff22190ad526dc1b Mon Sep 17 00:00:00 2001 From: defanor Date: Sat, 27 Jan 2024 23:04:26 +0300 Subject: Rewrite, version 0.2: use Parsec, focus on DSV --- examples/Basic.hs | 16 ++++++------- examples/Pipes.hs | 67 ------------------------------------------------------- 2 files changed, 7 insertions(+), 76 deletions(-) delete mode 100644 examples/Pipes.hs (limited to 'examples') 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 -- cgit v1.2.3