summaryrefslogtreecommitdiff
path: root/Coalpit
diff options
context:
space:
mode:
authordefanor <defanor@uberspace.net>2017-12-20 10:12:52 +0300
committerdefanor <defanor@uberspace.net>2017-12-20 10:12:52 +0300
commitb2435e1e37b9def481761a00c704d280ef2deb96 (patch)
tree165aa7466248700d9820eaabb3e507ac06225822 /Coalpit
parent3350f07b88a4628d83abaf9eaea2f0dfc2e44edf (diff)
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.
Diffstat (limited to 'Coalpit')
-rw-r--r--Coalpit/IO.hs83
1 files changed, 0 insertions, 83 deletions
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 <defanor@uberspace.net>
-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 [])