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:
- Compiler doesn't like
keyVal
as its a list of tuple, where the 2nd value is different
- Even though I assign
Asc
or Desc
to direction
the complier doesn't accept it
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"