[Haskell-cafe] Newbie question about Parsec

Daniel Fischer daniel.is.fischer at web.de
Mon Jan 18 13:41:32 EST 2010


Am Montag 18 Januar 2010 19:09:23 schrieb david fries:
> Hey everybody
>
> I've been playing around with Parsec a little bit lately. I like it a
> lot, but now I've hit a bit of a challenge. Suppose I have to parse a
> variable length string representing a time interval. Depending on how
> many fields there are, the time is either interpreted as seconds,
> minutes and seconds or hours, minutes and seconds.
>
> For example:
>
> "... 31 ..." would be parsed as 31 seconds.
> "... 05:31 ..." would be parsed as 5 minutes and 31 seconds.
> "... 01:05:31 ..." would be parsed as 1 hour, 5 minutes and 31 seconds.
>
> I've come up with the following solution using optionMaybe to deal with
> the problem:
>
> data ElapsedTime = ElapsedTime {
>      hours :: Int,
>      minutes :: Int,
>      seconds :: Int
> } deriving (Show, Eq, Ord)
>
> p_elapsed_time :: CharParser () ElapsedTime
> p_elapsed_time = toElapsedTime <$> (optionMaybe p_Int)
>                                <*> (optionMaybe (char ':' *> p_Int))
>                                <*> (optionMaybe (char ':' *> p_Int <*
> skipSpaces))
>     where toElapsedTime Nothing Nothing Nothing = ElapsedTime 0 0 0
>           toElapsedTime (Just s) Nothing Nothing = ElapsedTime 0 0 s
>           toElapsedTime (Just m) (Just s) Nothing = ElapsedTime 0 m s
>           toElapsedTime (Just h) (Just m) (Just s) = ElapsedTime h m s
>

p_elapsed_time = toElapsedTime <$> sepBy p_int (char ':')
   where
      toElapsedTime (h:m:s:_) = ElapsedTime h m s
      toElapsedTime [m,s]     = ElapsedTime 0 m s
      toElapsedTime [s]       = ElapsedTime 0 0 s
      toElapsedTime []        = ElapsedTime 0 0 0

You can replace the first pattern for toElapsedTime with [h,m,s] and add a 
failure case if sepBy p_int (char ':') parses more than three ints (or 
write a combinator that parses up to n results of p separated by sep).

Or

p_elapsed_time = do
    s <- p_int
    et <- cont_elapsed_time (ElapsedTime 0 0 s)

cont_elapsed_time et@(ElapsedTime h m s) = do
    char ':'
    n <- p_int
    cont_elapsed_time (ElapsedTime m s n)
   <|> return et

>
> Where p_Int simply parses a sequence of digits as an Int and skipSpaces
> does just that.
>
> This works correctly, but it also feels kinda clumsy. For one the
> compiler rightly complains about non-exhaustive pattern matches in the
> definition of the toElapsedTime function, although I believe that's
> negligible in that particular case.
> Is there a better i.e. more elegant way to tackle such a problem?
>
> regards,
> david




More information about the Haskell-Cafe mailing list