1

I'm trying to parse dates such as 09/10/2015 17:20:52:

{-# LANGUAGE FlexibleContexts #-}

import Text.Parsec
import Text.Parsec.String
import Text.Read
import Control.Applicative hiding (many, (<|>))

data Day = Day
  { mo  :: Int
  , dy  :: Int
  , yr  :: Int
  } deriving (Show)

data Time = Time
  { hr  :: Int
  , min :: Int
  , sec :: Int
  } deriving (Show)

day  = listUncurry Day  <$> (sepCount 3 (char '/') $ read <$> many digit)
time = listUncurry Time <$> (sepCount 3 (char ':') $ dign 2             )

dign :: (Stream s m Char, Read b) => Int -> ParsecT s u m b
dign = (read <$>) . flip count digit

-- how generalize to n?
listUncurry h [x1,x2,x3] = h x1 x2 x3

sepCount n sep p = (:) <$> p <*> (count (n-1) $ sep *> p)

I have a hunch that some kind of zipWithN would generalize listUncurry. Maybe some kind of foldl ($)?

As a side question (out of curiosity), can parsec parsers be used generatively?

jub0bs
  • 60,866
  • 25
  • 183
  • 186
user1441998
  • 459
  • 4
  • 14
  • `listUncurry` uses monadic `do` but has no reason to -- i want to fix both that and the polyvariadicity :) – user1441998 Sep 12 '15 at 04:10
  • So indeed I was missing something... Eliminating the `do` might be as simple as `fmap (\[x1,x2,x3] -> h x1 x2 x3) p`, as in David Young's answer. – duplode Sep 12 '15 at 04:20
  • 1
    @duplode You should not have edited your questions after finding the answer. If there is an answer you like, you should accept it (click the tick beneath it) and leave it as such for future visitors to see. – AJF Sep 12 '15 at 12:40
  • the answer showed that i had focused on a trivial problem in the title, but you can see the edits only changed about 1% of the content -- none of the three specific questions at the bottom were addressed. i upvoted him to thank him for helping me find and clarify the heart of the matter. :) – user1441998 Sep 12 '15 at 16:29
  • Related: http://stackoverflow.com/questions/3775446/passing-list-elements-as-parameters-to-curried-function – jub0bs Sep 26 '15 at 12:16

2 Answers2

7

Actually, you only need Functor:

listUncurry :: Functor f => (a -> a -> a -> r) -> f [a] -> f r
listUncurry h p =
  (\[x, y, z] -> h x y z) <$> p

To me, a hint that only Functor is necessary is when you have a code pattern like:

do x <- m
   return (f ...)

This is equivalent to

m >>= (\x -> return (f ...))

which is the same as

fmap (\x -> f ...) m

This is because the monad laws imply this identity:

fmap f xs  =  xs >>= return . f

Polyvariadic listUncurry

I don't really recommend this in most circumstances since it turns what would be compile time errors into runtime errors, but this is how you could implement a polyvariadic listUncurry:

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances     #-}

class ListUncurry a x r where
  listUncurry :: a -> [x] -> r

instance ListUncurry k a r => ListUncurry (a -> k) a r where
  listUncurry f (x:xs) = listUncurry (f x) xs
  listUncurry _ _      = error "listUncurry: Too few arguments given"

instance ListUncurry r a r where
  listUncurry r [] = r
  listUncurry _ _  = error "listUncurry: Too many arguments given"

You will need a lot of explicit type annotations if you use it too. There is probably a way to use a type family or functional dependency to help with that, but I can't think of it off the top of my head at the moment. Since that is probably solvable (to an extent at least), in my mind the bigger problem is the type errors being changed from compile time errors to runtime errors.

Sample usage:

ghci> listUncurry ord ['a'] :: Int
97
ghci> listUncurry ((==) :: Int -> Int -> Bool) [1,5::Int] :: Bool
False
ghci> listUncurry ((==) :: Char -> Char -> Bool) ['a'] :: Bool
*** Exception: listUncurry: Too few arguments given
ghci> listUncurry ((==) :: Char -> Char -> Bool) ['a','b','c'] :: Bool
*** Exception: listUncurry: Too many arguments given

A safer listUncurry

If you change the class to

class ListUncurry a x r where
  listUncurry :: a -> [x] -> Maybe r

and change the error cases in the instances appropriately, you will at least get a better interface to handling the errors. You could also replace the Maybe with a type that differentiates between the "too many" and "too few" argument errors if you wanted to retain that information.

I feel that this would be a bit better of an approach, although you will need to add a bit more error handling (Maybe's Functor, Applicative and Monad interfaces will make this fairly nice though).

Comparing the two approaches

It ultimately depends on what sort of error this would represent. If the program execution can no longer continue in any meaningful way if it runs into such an error, then the first approach (or something like it) might be more appropriate than the second. If there is any way to recover from the error, the second approach would be better than the first.

Whether or not a polyvariadic technique should be used in the first place is a different question. It might be better to restructure the program to avoid the additional complexity of the polyvariadic stuff.

David Young
  • 10,713
  • 2
  • 33
  • 47
  • heh ok that's fair, i guess what i really was interested in was how to use `(<*>)` to make it polyvariadic... – user1441998 Sep 12 '15 at 04:25
  • i'll change the q to refocus on that, but let me know if you'd rather i start a new question and give you credit for answering this one :) – user1441998 Sep 12 '15 at 04:27
  • @user1441998 Usually the suggestion is to make a new question so that the existing answers aren't invalid. About the polyvariadic issue, unless you use some type class tricks which I would not really recommend for this, this is not possible (you cannot write the type of a polyvariadic `listUncurry` without the type class trick, let alone give an implementation). I added a possible way to use the type class trick to my answer though, to show how it could work and demonstrate the downsides of the approach. – David Young Sep 26 '15 at 16:44
  • Thinking about it some more, the polyvariadic solution *could* work better than I thought originally, depending on the circumstances of the problem. It depends on what it means for an error to occur in `listUncurry` (I added a discussion about this issue to the answer). – David Young Sep 26 '15 at 17:02
2

also i'm sure i shouldn't be snocing a list -- what's the right way to do this?

The following implementation of sepCount is more efficient:

-- | @sepCount n sep p@ applies @n@ (>=1) occurrences of @p@,
-- separated by @sep@. Returns a list of the values returned by @p@. 
sepCount n sep p = p <:> count (n - 1) (sep *> p)
  where (<:>) = liftA2 (:)
jub0bs
  • 60,866
  • 25
  • 183
  • 186