packages feed

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 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