[web-devel] ANN: url-generic-0.1: Parse/format generic key/value URLs from record data types.

[Christopher Done]

On 20 June 2011 20:05, Jeremy Shaw <jeremy at n-heptane.com> wrote:
> Hello,
>
> How is this actually different from web-routes (which already supports
> automatic url deriving via Template Haskell, generics, or
> quasi-quotation)?

1) Erm, it's actually documented? ;-)

> You suggest that web-routes requires a single URL type for all the
> routes and that your code allows for multiple types. But I do not see
> how that is actually done.

2)

{-# LANGUAGE RecordWildCards, DeriveDataTypeable #-}

import Data.Data
import Data.List
import Data.Maybe
import Web.URL.Generic

data Event = Event { eventId     :: Integer -- ^ The event id.
                   , eventScope  :: Bool    -- ^ Show the scope?
                   , eventLayout :: Layout  -- ^ Layout for the page.
                   }
  deriving (Data,Typeable,Show)

data Layout =
  Wide | Thin | Collapsed
  deriving (Typeable,Data,Show,Enum)

data Home = Home
  deriving (Data,Typeable,Show)

router :: String -> IO String
router url =
 fromMaybe (error "404!")
           (listToMaybe $ mapMaybe ($ url) routes)

routes :: [String -> Maybe (IO String)]
routes = [route eventPage
         ,route homePage]

route :: Data a => (a -> IO String) -> (String -> Maybe (IO String))
route handler url =
  case parseURLPath url of
    Just a -> Just $ handler a
    Nothing -> Nothing

eventPage :: Event -> IO String
eventPage Event{..} = return $
  "Event page! Layout: " ++ show eventLayout

homePage :: Home -> IO String
homePage Home = return $
  "Home page! Click here to go to the event page: " ++
  formatURLPath Event { eventId = 1, eventScope = False, eventLayout = Thin }

λ> router "/event/id/1/layout/wide"
Loading package syb-0.1.0.2 ... linking ... done.
Loading package transformers-0.2.2.0 ... linking ... done.
Loading package mtl-2.0.1.0 ... linking ... done.
"Event page! Layout: Wide"
λ> router "/home"
"Home page! Click here to go to the event page: /event/id/1/layout/thin"
λ> router ""
*** Exception: 404!