example1.hs

{-# LANGUAGE OverloadedStrings #-}

module Main (main) where

import           Control.Applicative
import qualified Data.Attoparsec.Text     as A
import qualified Data.Text                as T
import           Control.Monad
import           Control.Monad.Trans.Class
import           Control.Monad.ST
import           Control.Proxy            ((>->))
import qualified Control.Proxy            as P
import qualified Control.Proxy.Trans.Either as P
import           Control.Proxy.Parse      (parse, spoil, ParseP)
import qualified Control.Proxy.Attoparsec as PA

digit :: A.Parser Int
digit = read . (:"") <$> A.digit

sourceFine :: (Monad m, P.Proxy p) => () -> P.Producer p T.Text m ()
sourceFine = P.fromListS ["12","3"]

sourceBad :: (Monad m, P.Proxy p) => () -> P.Producer p T.Text m ()
sourceBad = P.fromListS ["1x3","4"]


-- | For each digit @n@ received from upstream, send downstream @(n, odd n)@.
oddities
  :: P.Proxy p
  => () -> P.Pipe (ParseP s T.Text (P.EitherP PA.ParserError p))
                  (Maybe T.Text) (Int, Bool) (ST s) b
oddities () = forever $ do
   n <- PA.parseD digit
   P.respond (n, odd n)

-- | Like 'oddities', but skips non-digit characters instead of aborting.
odditiesMaybe
  :: P.Proxy p
  => () -> P.Pipe (ParseP s T.Text p) (Maybe T.Text) (Int, Bool) (ST s) ()
odditiesMaybe () = do
   mn <- PA.maybeParseD digit
   case mn of
     Just n  -> do P.respond (n, odd n)
                   odditiesMaybe ()
     Nothing -> do nskipped <- PA.skipN 1
                   if nskipped == 0
                      then return ()
                      else odditiesMaybe ()

-- | Like 'odditiesMaybe', but also prints an error message each time a
-- non-digit character is found.
odditiesEither
 :: P.Proxy p
  => () -> ParseP RealWorld T.Text p () (Maybe T.Text) () (Int, Bool) IO ()
odditiesEither () = do
   en <- spoil $ PA.eitherParseD digit
   case en of
     Right n -> do P.respond (n, odd n)
                   odditiesEither ()
     Left e  -> do lift . putStrLn $ "Skipping parsing error: " ++ show e
                   nskipped <- spoil $ PA.skipN 1
                   if nskipped == 0
                      then return ()
                      else odditiesEither ()


main :: IO ()
main = do
  putStrLn "*** Using 'sourceFine' ***"

  putStrLn "--------------------"
  putStrLn "* oddities"
  er <- P.runProxy . P.runEitherK $ spoil . parse id sourceFine oddities >-> P.printD
  case er of
    Left  e -> putStrLn $ "Bad oddities: " ++ show e
    Right _ -> return ()

  putStrLn "--------------------"
  putStrLn "* odditiesEither"
  P.runProxy $ parse spoil sourceFine odditiesEither >-> P.printD

  putStrLn "--------------------"
  putStrLn "* odditiesMaybe"
  P.runProxy $ spoil . parse id sourceFine odditiesMaybe >-> P.printD

  putStrLn "\n*** Using 'sourceBad' ***"
  -- the same code as above follows, except using 'sourceBad' instead of 'sourceFine'.

  putStrLn "--------------------"
  putStrLn "* oddities"
  er <- P.runProxy . P.runEitherK $ spoil . parse id sourceBad oddities >-> P.printD
  case er of
    Left  e -> putStrLn $ "Bad oddities: " ++ show e
    Right _ -> return ()

  putStrLn "--------------------"
  putStrLn "* odditiesEither"
  P.runProxy $ parse spoil sourceBad odditiesEither >-> P.printD

  putStrLn "--------------------"
  putStrLn "* odditiesMaybe"
  P.runProxy $ spoil . parse id sourceBad odditiesMaybe >-> P.printD

example1.txt

*** Using 'sourceFine' ***
--------------------
* oddities
(1,True)
(2,False)
(3,True)
Bad oddities: ParserError {errorContexts = ["digit","demandInput"], errorMessage = "not enough input"}
--------------------
* odditiesEither
(1,True)
(2,False)
(3,True)
Skipping parsing error: ParserError {errorContexts = ["digit","demandInput"], errorMessage = "not enough input"}
--------------------
* odditiesMaybe
(1,True)
(2,False)
(3,True)

*** Using 'sourceBad' ***
--------------------
* oddities
(1,True)
Bad oddities: ParserError {errorContexts = ["digit"], errorMessage = "Failed reading: satisfy"}
--------------------
* odditiesEither
(1,True)
Skipping parsing error: ParserError {errorContexts = ["digit"], errorMessage = "Failed reading: satisfy"}
(3,True)
(4,False)
Skipping parsing error: ParserError {errorContexts = ["digit","demandInput"], errorMessage = "not enough input"}
--------------------
* odditiesMaybe
(1,True)
(3,True)
(4,False)