From b2435e1e37b9def481761a00c704d280ef2deb96 Mon Sep 17 00:00:00 2001 From: defanor 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. --- Coalpit.hs | 2 -- Coalpit/IO.hs | 83 ------------------------------------------------------- Example.hs | 45 ------------------------------ README.md | 4 +-- coalpit.cabal | 5 ++-- examples/Basic.hs | 45 ++++++++++++++++++++++++++++++ examples/Pipes.hs | 66 +++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 115 insertions(+), 135 deletions(-) delete mode 100644 Coalpit/IO.hs delete mode 100644 Example.hs create mode 100644 examples/Basic.hs create mode 100644 examples/Pipes.hs diff --git a/Coalpit.hs b/Coalpit.hs index fda836a..6eb7f06 100644 --- a/Coalpit.hs +++ b/Coalpit.hs @@ -59,9 +59,7 @@ Then, in a shell: module Coalpit ( module Coalpit.Core , module Coalpit.DSV - , module Coalpit.IO ) where import Coalpit.Core import Coalpit.DSV -import Coalpit.IO diff --git a/Coalpit/IO.hs b/Coalpit/IO.hs deleted file mode 100644 index c33fd98..0000000 --- a/Coalpit/IO.hs +++ /dev/null @@ -1,83 +0,0 @@ -{- | -Module : Coalpit.IO -Description : Helper IO functions -Maintainer : defanor -Stability : unstable -Portability : non-portable (uses GHC extensions) - -These are basic utility functions for pipes-based IO. - -An example: - -@ -\{\-\# LANGUAGE DeriveGeneric, DeriveAnyClass \#\-\} -import GHC.Generics -import Pipes.Prelude as PP -import Coalpit - -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 = run' $ \a -> PP.mapM $ \(Input i) -> - pure $ Foo $ maybe (arg2 a) fromIntegral (arg1 a) + i -@ - --} - -{-# LANGUAGE RankNTypes, ScopedTypeVariables #-} - -module Coalpit.IO (run, run', 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) - --- | 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'. -run :: 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 () -run 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 'run', but just prints errors into 'stderr'. -run' :: forall m a i o. (MonadIO m, Coalpit a, Coalpit i, Coalpit o) - => (a -> Pipe i o m ()) - -- ^ Main function. - -> m () -run' = run (\e -> liftIO $ hPutStrLn stderr e >> pure []) diff --git a/Example.hs b/Example.hs deleted file mode 100644 index a08730d..0000000 --- a/Example.hs +++ /dev/null @@ -1,45 +0,0 @@ -{-# 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/README.md b/README.md index f9e3d7f..cb248ad 100644 --- a/README.md +++ b/README.md @@ -23,8 +23,8 @@ Not production-ready yet, merely a prototype. ## Example -An example is available in `Example.hs`. Given the following Haskell -value: +An example is available in `examples/Basic.hs`. Given the following +Haskell value: ```haskell Input { something = Nothing diff --git a/coalpit.cabal b/coalpit.cabal index 6fa969f..207ee64 100644 --- a/coalpit.cabal +++ b/coalpit.cabal @@ -14,8 +14,9 @@ maintainer: defanor@uberspace.net category: Console build-type: Simple extra-source-files: ChangeLog.md - , Example.hs , README.md + , examples/Basic.hs + , examples/Pipes.hs cabal-version: >=1.10 tested-with: GHC == 8.0.1, GHC == 8.0.2, GHC == 8.2.1 bug-reports: https://github.com/defanor/coalpit/issues @@ -27,14 +28,12 @@ library exposed-modules: Coalpit , Coalpit.Core , Coalpit.DSV - , Coalpit.IO , Coalpit.Parsing build-depends: base >= 4.9 && < 5 , megaparsec >= 6.2 && < 7 , scientific >= 0.3 && < 1 , time >= 1.6 && < 2 , network-uri >= 2.6 && < 3 - , pipes >= 4.3 && < 5 default-language: Haskell2010 ghc-options: -Wall 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