web-routes-boomerang 0.26.0 → 0.27.0
raw patch · 2 files changed
+44/−18 lines, 2 filesdep +parsecdep ~boomerangPVP ok
version bump matches the API change (PVP)
Dependencies added: parsec
Dependency ranges changed: boomerang
API changes (from Hackage documentation)
- Web.Routes.Boomerang: boomerangSite :: ((url -> [(Text, Maybe Text)] -> Text) -> url -> a) -> Router url -> Site url a
+ Web.Routes.Boomerang: boomerangSite :: ((url -> [(Text, Maybe Text)] -> Text) -> url -> a) -> Router () (url :- ()) -> Site url a
- Web.Routes.Boomerang: boomerangSiteRouteT :: (url -> RouteT url m a) -> Router url -> Site url (m a)
+ Web.Routes.Boomerang: boomerangSiteRouteT :: (url -> RouteT url m a) -> Router () (url :- ()) -> Site url (m a)
- Web.Routes.Boomerang: type Router url = PrinterParser StringsError [String] () (url :- ())
+ Web.Routes.Boomerang: type Router a b = PrinterParser TextsError [Text] a b
Files
- Web/Routes/Boomerang.hs +41/−16
- web-routes-boomerang.cabal +3/−2
Web/Routes/Boomerang.hs view
@@ -103,10 +103,10 @@ Now we can create a simple test function that takes the path info part of a url and runs our site: -> test :: String -- ^ path info of incoming url+> test :: ByteString -- ^ path info of incoming url > -> IO ()-> test path = -> case runSite "" site path of+> test path =+> case runSite "" site (decodePathInfo path) of > (Left e) -> putStrLn e > (Right io) -> io @@ -123,26 +123,26 @@ > -- | interactively call 'test' > main :: IO () > main = mapM_ test =<< fmap lines getContents- + Here are two more helper functions you can use to experiment interactively: > -- | a little function to test rendering a url > showurl :: Sitemap -> String-> showurl url = +> showurl url = > let (ps, params) = formatPathSegments site url > in (encodePathInfo ps params) > -- | a little function to test parsing a url > testParse :: String -> Either String Sitemap-> testParse pathInfo = +> testParse pathInfo = > case parsePathSegments site $ decodePathInfo pathInfo of > (Left e) -> Left (show e) > (Right a) -> Right a -}-module Web.Routes.Boomerang +module Web.Routes.Boomerang ( module Text.Boomerang- , module Text.Boomerang.Strings+ , module Text.Boomerang.Texts , Router , boomerangSite , boomerangSiteRouteT@@ -150,28 +150,53 @@ import Data.Text (Text, pack, unpack) import Text.Boomerang -- (PrinterParser(..), ParserError(..), (:-), condenseErrors, parse1, showParserError, unparse1)-import Text.Boomerang.Strings -- (StringsPos(..), isComplete)-import Web.Routes (RouteT(..), Site(..))+import Text.Boomerang.Texts -- (StringsPos(..), isComplete)+import Text.ParserCombinators.Parsec.Prim (State(..), getParserState, setParserState)+import Text.Parsec.Pos (sourceLine, sourceColumn, setSourceColumn, setSourceLine)+import Web.Routes (RouteT(..), Site(..), PathInfo(..), URLParser) -type Router url = PrinterParser StringsError [String] () (url :- ())+-- | 'Router a b' is a simple type alias for 'PrinterParser TextsError [Text] a b'+type Router a b = PrinterParser TextsError [Text] a b +-- | function which creates a 'Site' from a 'Router' and a handler boomerangSite :: ((url -> [(Text, Maybe Text)] -> Text) -> url -> a) -- ^ handler function- -> Router url -- ^ the router+ -> Router () (url :- ()) -- ^ the router -> Site url a boomerangSite handler r@(PrinterParser pf sf) = Site { handleSite = handler , formatPathSegments = \url ->- case unparseStrings r url of+ case unparseTexts r url of Nothing -> error "formatPathSegments failed to produce a url"- (Just ps) -> (map pack ps, [])- , parsePathSegments = \paths -> mapLeft (showErrors paths) (parseStrings r $ map unpack paths)+ (Just ps) -> (ps, [])+ , parsePathSegments = \paths -> mapLeft (showErrors paths) (parseTexts r paths) } where mapLeft f = either (Left . f) Right showErrors paths err = (showParserError showPos err) ++ " while parsing " ++ show paths showPos (MajorMinorPos s c) = "path segment " ++ show (s + 1) ++ ", character " ++ show c +-- | function which creates a 'Site' from a 'Router' and a 'RouteT' handler boomerangSiteRouteT :: (url -> RouteT url m a) -- ^ handler function- -> Router url -- ^ the router+ -> Router () (url :- ()) -- ^ the router -> Site url (m a) boomerangSiteRouteT handler router = boomerangSite (flip $ unRouteT . handler) router++-- | convert to a 'URLParser' so we can create a 'PathInfo' instance+boomerangFromPathSegments :: PrinterParser TextsError [Text] () (url :- ()) -> URLParser url+boomerangFromPathSegments (PrinterParser prs _) =+ do st <- getParserState+ let results = runParser prs (stateInput st) (MajorMinorPos (fromIntegral $ sourceLine (statePos st)) (fromIntegral $ sourceColumn (statePos st)))+ case [ ((f (), tok), pos) | (Right ((f, tok), pos)) <- results, isComplete tok ] of+ ((((u :- ()), tok), pos) : _) ->+ do let st' = st { statePos = setSourceColumn (setSourceLine (statePos st) (fromIntegral $ major pos)) (fromIntegral $ minor pos)+ , stateInput = tok+ }+ setParserState st'+ return u++-- | convert to the type expected by 'toPathSegments' from 'PathInfo'+boomerangToPathSegments :: PrinterParser TextsError [Text] () (url :- ()) -> (url -> [Text])+boomerangToPathSegments pp =+ \url -> case unparse1 [] pp url of+ Nothing -> error $ "boomerangToPathSegments: could not convert url to [Text]"+ (Just txts) -> txts
web-routes-boomerang.cabal view
@@ -1,5 +1,5 @@ Name: web-routes-boomerang-Version: 0.26.0+Version: 0.27.0 License: BSD3 License-File: LICENSE Author: jeremy@seereason.com@@ -13,8 +13,9 @@ Library Build-Depends: base >= 4 && < 5,- boomerang,+ boomerang >= 1.3.2, mtl,+ parsec == 3.1.*, text == 0.11.*, web-routes >= 0.26 Exposed-Modules: Web.Routes.Boomerang