How to generalize a list with different EntityFiel

Question

I try to generalize the URL handling when going to for example /api/v1.0/events?order=-id,title for a RESTful output - so the results will order by id desc, and than by title asc

Models file:

-- models

Event
    title Text
    content Text
    userId UserId
    deriving Eq
    deriving Show

Haskell file:

-- Events.hs

text2Order :: Text -> [SelectOpt Event]
text2Order text =
  case lookup textWithNoPrefix keyVal of
    Just val -> [direction val]
    Nothing -> error "wrong order"

  where
    keyVal = [ ("title", EventTitle)
             , ("user" , EventUserId)
             , ("id"   , EventId)
             ]

    textWithNoPrefix = if T.isPrefixOf "-" text
              then T.tail text
              else text

    direction = if T.isPrefixOf "-" text
              then Desc
              else Asc

I seem to have two problems:

1. Compiler doesn't like keyVal as its a list of tuple, where the 2nd value is different
2. Even though I assign Asc or Desc to direction the complier doesn't accept it

Answer 1

The problem is that EventTitle and EventUserId are of different types, so you can't put the two of them in the same list. You can, however, put EventTitle and EventContent in the same list -- they both have type EntityField Event Text.

However, an approach like the following should work (using the Person example from the Yesod tutorial):

makeSelectOpt :: (Char,Char) -> SelectOpt Person
makeSelectOpt ('f','+') = Asc  PersonFirstName
makeSelectOpt ('f','-') = Desc PersonFirstName
makeSelectOpt ('l','+') = Asc  PersonLastName
makeSelectOpt ('l','-') = Desc PersonFirstName
makeSelectOpt ('a','+') = Asc  PersonAge
makeSelectOpt ('a','-') = Desc PersonAge

makeSelections :: [(Char,Char)] -> [SelectOpt Person]
makeSelections = map makeSelectOpt

You can factor out the +/- processing like this:

updown '+' = Asc
updown _   = Desc

makeSelectOpt' :: (Char,Char) -> SelectOpt Person
makeSelectOpt' ('f',dir)  = updown dir $ PersonFirstName
makeSelectOpt' ('l',dir)  = updown dir $ PersonLastName
makeSelectOpt' ('a',dir)  = updown dir $ PersonAge

If you want to perform error processing, return a Maybe (SelectOpt Person):

makeSelectOpt'' :: (Char,Char) -> Maybe (SelectOpt Person)
makeSelectOpt'' ('f',dir)  = Just $ updown dir $ PersonFirstName
makeSelectOpt'' ('l',dir)  = Just $ updown dir $ PersonLastName
makeSelectOpt'' ('a',dir)  = Just $ updown dir $ PersonAge
makeSelectOpt'' _          = Nothing

and then:

makeSelectOpts'' :: [(Char,Char)] -> Maybe [SelectOpt Person)
makeSelectOpts'' pairs = mapM makeSelectOpt'' pairs

The result will be Just [...] if all of the pairs are valid and Nothing if any one of them isn't recognized.

Update

Here is another approach using existential types which looks a lot more like your code:

{-# LANGUAGE RankNTypes #-}

type ApplyToField = (forall t. EntityField Person t -> SelectOpt Person) -> SelectOpt Person

applyToFirstName, applyToLastName, applyToAge :: ApplyToField
applyToFirstName d = d PersonFirstName
applyToLastName d  = d PersonFirstName
applyToAge     d   = d PersonAge

makeSelectOpt''' :: (Char,Char) -> SelectOpt Person
makeSelectOpt''' (fld,d) = fn (updown d)
  where
    table = [ ('f',applyToFirstName), ('l',applyToLastName), ('a',applyToAge) ]
    fn = case lookup fld table of
           Just f -> f
           Nothing -> error "bad field spec"