Skip to content

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
> {-# LANGUAGE GADTs, TypeOperators, TupleSections #-}
> module Routing2 where
> import Control.Applicative hiding (many, (<|>))
> import Text.ParserCombinators.Parsec.Prim
> import Text.ParserCombinators.Parsec.Error
> import Text.ParserCombinators.Parsec.Char
> import Text.ParserCombinators.Parsec.Combinator
> import Data.List (intercalate)
In this file we build another routing library. This library couples the routes
and the handler functions. As an example, consider the following schema:
Note that all the handler functions have the same result type (String). In a
Happstack application, it would be ServerPart instead of String.
> mySchema :: [Route String]
> mySchema =
> [ handleIndex <$ Index
> , handleUser <$ Dir "user" <*> Int
> , handleStatic <$ Dir "static" <*> Rest
> ]
> handleIndex :: String
> handleUser :: Int -> String
> handleStatic :: [String] -> String
> handleIndex = "index!"
> handleUser x = "looking up user: " ++ show x
> handleStatic = unlines
Try printing mySchema in GHCi.
We can build a |test| function that finds the correct handler for us:
> test :: [String] -> Either ParseError String
> test = parse (parseRoutes mySchema) ""
All these should deliver an IO action (wrapped in a Right)
> succeed1 = test []
> succeed2 = test ["user", "27"]
> succeed3 = test ["static", "some", "more"]
These tests should give an error message.
> fail1 = test ["hi"]
> fail2 = test ["user","a string"]
Now we proceed with the library definition:
> instance Show (Route a) where
> show = intercalate "/" . showRoute
> data Route a where
> Index :: Route ()
> Dir :: String -> Route ()
> String :: Route String
> Int :: Route Int
> Rest :: Route [String]
> Pure :: p -> Route p
> (:*:) :: Route (a -> b) -> Route a -> Route b
> instance Functor Route where
> fmap f = (:*:) (Pure f)
> instance Applicative Route where
> pure = Pure
> (<*>) = (:*:)
> parseRoute :: Route a -> URLParser a
> parseRoute Index = eof >> return ()
> parseRoute (Dir d) = segment d >> return ()
> parseRoute (String) = anySegment
> parseRoute (Int) = parseInt
> parseRoute Rest = many anySegment
> parseRoute (Pure p) = return p
> parseRoute (l :*:r ) = do l' <- parseRoute l
> r' <- parseRoute r
> return (l' r')
> type URLSchema a = [Route a]
> parseRoutes :: URLSchema a -> URLParser a
> parseRoutes = choice . map parseRoute
A utility function. Could be used by Template Haskell.
> isValidRoute :: URLSchema a -> [String] -> Bool
> isValidRoute schema route =
> case parse (parseRoutes schema) "" route of
> Left _ -> False
> Right _ -> True
> showRoute :: Route a -> [String]
> showRoute Index = [""]
> showRoute (Dir d) = [d]
> showRoute String = ["$"]
> showRoute Int = ["#"]
> showRoute Rest = ["*"]
> showRoute (Pure _) = []
> showRoute (l :*: r) = showRoute l ++ showRoute r
Now the URL parsing functionality from the previous time:
> type URLParser a = GenParser String () a
>
> segment :: String -> URLParser String
> segment x = pToken (const x) (\y -> if x == y then Just x else Nothing)
>
> anySegment :: URLParser String
> anySegment = pToken (const "any string") Just
>
> pToken msg f = do pos <- getPosition
> token id (const pos) f
>
> parseInt :: URLParser Int
> parseInt = pToken (const "integer") checkInt
> where checkInt str =
> case reads str of
> [(n,[])] -> Just n
> _ -> Nothing
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.