parsec and a never terminating parser

25 Mar 2015

      I'm having trouble understanding why my simple parser never terminates when
specific input is used.

For example, let's say the first column is a field which can be in one of 4
states, empty, omitted, other, and any arbitrary value. That is,

    data FieldState a = EmptyState | OmittedState | OtherState | FullState a
      deriving (Eq, Ord)

When attempting to use,

    $ echo "- " | ./parser
    "- \n"
    empty ('-')
    $ echo "^ " | ./parser
    "^ \n"
    omitted ('^')
    $ echo "~ " | ./parser
    "~ \n"
    other ('~')
    [ all of this is as expected ]
    $ echo "1 " | ./parser
    "1 \n"
    [ computer twiddles it's thumbs here until I manually terminate it ... ]
    ^C^C
    $

Does anyone know what's happening and now to alleviate it?

-- begin full code --

-- base
import Control.Applicative
import Data.Word

-- Hackage
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.IO as TLIO
import Text.Parsec (parse)
import Text.Parsec.Text.Lazy (Parser)
import Text.Parser.Combinators
import Text.Parser.Char

data FieldState a = EmptyState | OmittedState | OtherState | FullState a
  deriving (Eq, Ord)

instance Functor FieldState where
    fmap f (FullState a)    = FullState (f a)
    fmap _ EmptyState       = EmptyState
    fmap _ OmittedState     = OmittedState
    fmap _ OtherState       = OtherState

instance Applicative FieldState where
    pure = FullState
    (FullState f) <*> (FullState x) = FullState (f x)
    _             <*> _             = EmptyState

instance Monad FieldState where
    (FullState x) >>= k = k x
    EmptyState    >>= _ = EmptyState
    OmittedState  >>= _ = OmittedState
    OtherState    >>= _ = OtherState

    (FullState _) >> k = k
    EmptyState    >> _ = EmptyState
    OmittedState  >> _ = OmittedState
    OtherState    >> _ = OtherState

    return  = FullState
    fail _  = EmptyState

instance Show (FieldState x) where
    show (EmptyState)   = "empty ('-')"
    show (OmittedState) = "omitted ('^')"
    show (OtherState)   = "other ('~')"
    show x' = show x'

data Counter = Counter Word64 deriving (Eq, Ord, Show)

parseNum :: (Num a) => Parser a
parseNum = do
    n <- rd <$> many digit
    return $ fromIntegral n
    where rd = read :: String -> Integer

parseCounter :: Parser Counter
parseCounter = Counter <$> parseNum

parseFieldStateOff :: Parser Char
parseFieldStateOff = char '-'

parseFieldStateOmitted :: Parser Char
parseFieldStateOmitted = char '^'

parseFieldStateOther :: Parser Char
parseFieldStateOther = char '~'

parseFieldState :: Parser a -> Parser (FieldState a)
parseFieldState p = (parseFieldStateOff >> return EmptyState)
                  <|> (parseFieldStateOmitted >> return OmittedState)
                  <|> (parseFieldStateOther >> return OtherState)
                  <|> (p >>= return . FullState)

main :: IO ()
main = do
    ls <- TLIO.getContents
    print ls
    mapM_ processLine (TL.lines ls)

processLine :: TL.Text -> IO ()
processLine line = case (parse (parseFieldState parseCounter) "" line) of
  Left err -> print err
  Right xs -> print xs

Adam Flott

David McBride

Adam Flott

tags

participants (2)