fn 0.1.2.0 → 0.1.3.0

raw patch · 5 files changed

+84/−44 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• README.md +2/−2
• fn.cabal +1/−1
• src/Web/Fn.hs +50/−30
• test/Spec.hs +20/−11

@@ -1,3 +1,14 @@+* 0.1.3.0 Daniel Patterson <dbp@dbpmail.net> 2015-10-30++  - Allow nested calls to `route`, by changing `Request` in+    `ctxt`. This necesitated changing it so that the `ctxt` is passed+    to handlers _last_, instead of first, because we need to have+    completed matching before we can change the request.+  - Add `anything` route matcher that matches anything.+  - Add `paramMany` matcher that returns a list of values for the+    given query param.+  - Change `param` to fail if more than one value is in query string.+ * 0.1.2.0 Daniel Pattersion <dbp@dbpmail.net> 2015-10-27    Rename `paramOptional` to `paramOpt`, to match `fn-extra`'s `Heist`

@@ -46,7 +46,7 @@ index :: IO (Maybe Response) index = okText "This is the index page! Try /foo/bar/baz?id=10" -handler :: Ctxt -> Text -> Int -> IO (Maybe Response)-handler _ fragment i = okText (fragment <> " - " <> T.pack (show i))+handler :: Text -> Int -> Ctxt -> IO (Maybe Response)+handler fragment i _ = okText (fragment <> " - " <> T.pack (show i))  ```

@@ -1,5 +1,5 @@ name:                fn-version:             0.1.2.0+version:             0.1.3.0 synopsis:            A functional web framework. description:         Please see README. homepage:            http://github.com/dbp/fn#readme

@@ -33,9 +33,12 @@               , (/?)               , path               , end+              , anything               , segment               , FromParam(..)+              , ParamError(..)               , param+              , paramMany               , paramOpt                 -- * Responses               , okText@@ -49,11 +52,9 @@  import qualified Blaze.ByteString.Builder.Char.Utf8 as B import           Data.ByteString                    (ByteString)-import           Data.List                          (find)+import           Data.Either                        (rights) import           Data.Maybe                         (fromJust)-import           Data.Monoid                        ((<>)) import           Data.Text                          (Text)-import qualified Data.Text                          as T import qualified Data.Text.Encoding                 as T import           Data.Text.Read                     (decimal, double) import           Network.HTTP.Types@@ -137,15 +138,15 @@ -- patterns with varying numbers (and types) of parts with functions -- of the corresponding number of arguments and types. (==>) :: RequestContext ctxt =>-         (Req -> k -> Maybe (Req, a)) ->-         (ctxt -> k) ->+         (Req -> k -> Maybe (Req, ctxt -> a)) ->+         k ->          ctxt -> Maybe a (match ==> handle) ctxt =    let r = getRequest ctxt        x = (pathInfo r, queryString r)-   in case match x (handle ctxt) of+   in case match x handle of         Nothing -> Nothing-        Just (_, action) -> Just action+        Just ((pathInfo',_), action) -> Just (action (setRequest ctxt ((getRequest ctxt) { pathInfo = pathInfo' })))  -- | Connects two path segments. Note that when normally used, the -- type parameter r is 'Req'. It is more general here to facilitate@@ -184,6 +185,10 @@     [] -> Just (req, k)     _ -> Nothing +-- | Matches anything.+anything :: Req -> a -> Maybe (Req, a)+anything req k = Just (req, k)+ -- | Captures a part of the path. It will parse the part into the type -- specified by the handler it is matched to. If there is no segment, or -- if the segment cannot be parsed as such, it won't match.@@ -195,53 +200,68 @@                 Right p -> Just ((xs, snd req), k p)     _     -> Nothing +data ParamError = ParamMissing | ParamUnparsable | ParamOtherError Text deriving (Eq, Show)+ -- | A class that is used for parsing for 'param', 'paramOpt', and -- 'segment'. class FromParam a where-  fromParam :: Text -> Either Text a+  fromParam :: Text -> Either ParamError a  instance FromParam Text where   fromParam = Right instance FromParam Int where   fromParam t = case decimal t of-                  Left msg -> Left (T.pack msg)+                  Left _ -> Left ParamUnparsable                   Right m | snd m /= "" ->-                            Left ("Incomplete match: " <> T.pack (show m))+                            Left ParamUnparsable                   Right (v, _) -> Right v instance FromParam Double where   fromParam t = case double t of-                  Left msg -> Left (T.pack msg)+                  Left _ -> Left ParamUnparsable                   Right m | snd m /= "" ->-                            Left ("Incomplete match: " <> T.pack (show m))+                            Left ParamUnparsable                   Right (v, _) -> Right v --- | Matches on a query parameter of the given name. If there is no--- parameter, or it cannot be parsed into the type needed by the+-- | Matches on a single query parameter of the given name. If there is no+-- parameters, or it cannot be parsed into the type needed by the -- handler, it won't match. param :: FromParam p => Text -> Req -> (p -> a) -> Maybe (Req, a) param n req k =-  let match = find ((== T.encodeUtf8 n) . fst) (snd req)-  in case (maybe "" T.decodeUtf8 . snd) <$> match of-       Nothing -> Nothing-       Just p -> case fromParam p of-         Left _ -> Nothing-         Right p' -> Just (req, k p')+  let match = filter ((== T.encodeUtf8 n) . fst) (snd req)+  in case rights (map (fromParam . maybe "" T.decodeUtf8 . snd) match) of+       [x] -> Just (req, k x)+       _ -> Nothing --- | If the specified parameter is present, it will be parsed into the--- type needed by the handler, but if it isn't present or cannot be--- parsed, the handler will still be called (just with the 'Left'--- variant).+-- | Matches on query parameters of the given name. If there are no+-- parameters, or it cannot be parsed into the type needed by the+-- handler, it won't match.+paramMany :: FromParam p => Text -> Req -> ([p] -> a) -> Maybe (Req, a)+paramMany n req k =+  let match = filter ((== T.encodeUtf8 n) . fst) (snd req)+  in case map (maybe "" T.decodeUtf8 . snd) match of+       [] -> Nothing+       xs -> let ps = rights $ map fromParam xs in+             if length ps == length xs+                then Just (req, k ps)+                else Nothing++-- | If the specified parameters are present, they will be parsed into the+-- type needed by the handler, but if they aren't present or cannot be+-- parsed, the handler will still be called. paramOpt :: FromParam p =>             Text ->             Req ->-            (Either Text p -> a) ->+            (Either ParamError [p] -> a) ->             Maybe (Req, a) paramOpt n req k =-  let match = find ((== T.encodeUtf8 n) . fst) (snd req)-      p = ((maybe "" T.decodeUtf8 . snd) <$> match)-  in case p of-       Nothing -> Just (req, k (Left "param missing"))-       Just p' -> Just (req, k (fromParam p'))+  let match = filter ((== T.encodeUtf8 n) . fst) (snd req)++  in case map (maybe "" T.decodeUtf8 . snd) match of+       [] -> Just (req, k (Left ParamMissing))+       ps -> Just (req, k (foldLefts [] (map fromParam ps)))+  where foldLefts acc [] = Right (reverse acc)+        foldLefts _ (Left x : _) = Left x+        foldLefts acc (Right x : xs) = foldLefts (x : acc) xs  returnText :: Text -> Status -> ByteString -> IO (Maybe Response) returnText text status content =

@@ -18,7 +18,7 @@ main :: IO () main = hspec $ do -  describe "routing" $ do+  describe "matching" $ do     it "should match first segment with path" $       do path "foo" (["foo", "bar"], []) () `shouldSatisfy` isJust          path "foo" ([], []) () `shouldSatisfy` isNothing@@ -97,23 +97,23 @@       do (path "a" ==> const ())            (R (["a"], []))            `shouldSatisfy` isJust-         (segment ==> \_ (_ :: Text) -> ())+         (segment ==> \(_ :: Text) _ -> ())             (R (["a"], []))             `shouldSatisfy` isJust-         (segment // path "b" ==> \_ x -> x == ("a" :: Text))+         (segment // path "b" ==> \x _ -> x == ("a" :: Text))            (R (["a", "b"], []))            `shouldSatisfy` fromJust-         (segment // path "b" ==> \_ x -> x == ("a" :: Text))+         (segment // path "b" ==> \x _ -> x == ("a" :: Text))            (R (["a", "a"], []))            `shouldSatisfy` isNothing-         (segment // path "b" ==> \_ x -> x == ("a" :: Text))+         (segment // path "b" ==> \x _ -> x == ("a" :: Text))            (R (["a"], []))            `shouldSatisfy` isNothing     it "should always pass a value with paramOpt" $-      do paramOpt "id" ([], []) (isLeft :: Either Text Text -> Bool)+      do paramOpt "id" ([], []) (isLeft :: Either ParamError [Text] -> Bool)                   `shouldSatisfy` (snd . fromJust)          paramOpt "id" ([], [("id", Just "foo")])-                       (== Right ("foo" :: Text))+                       (== Right (["foo"] :: [Text]))                        `shouldSatisfy` (snd . fromJust)     it "should match end against no further path segments" $       do end ([],[]) () `shouldSatisfy` isJust@@ -123,7 +123,16 @@       do (path "a" // end) (["a"],[]) () `shouldSatisfy` isJust          (segment // end) (["a"],[]) (== ("a" :: Text))                                      `shouldSatisfy` isJust+    it "should match anything" $+      anything ([],[]) () `shouldSatisfy` isJust +  describe "route" $ do+    it "should match route to parameter" $+      do r <- route (R (["a"], [])) [segment ==> (\a _ -> if a == ("a"::Text) then okText "" else return Nothing)]+         (responseStatus <$> r) `shouldSatisfy` isJust+    it "should match nested routes" $+      do r <- route (R (["a", "b"], [])) [path "a" ==> (\c -> route c [path "b" ==> const (okText "")])]+         (responseStatus <$> r) `shouldSatisfy` isJust    describe "parameter parsing" $     do it "should parse Text" $@@ -132,13 +141,13 @@          do fromParam "1" `shouldBe` Right (1 :: Int)             fromParam "2011" `shouldBe` Right (2011 :: Int)             fromParam "aaa" `shouldSatisfy`-              (isLeft :: Either Text Int -> Bool)+              (isLeft :: Either ParamError Int -> Bool)             fromParam "10a" `shouldSatisfy`-              (isLeft :: Either Text Int -> Bool)+              (isLeft :: Either ParamError Int -> Bool)        it "should be able to parse Double" $          do fromParam "1" `shouldBe` Right (1 :: Double)             fromParam "1.02" `shouldBe` Right (1.02 :: Double)             fromParam "thr" `shouldSatisfy`-              (isLeft :: Either Text Double -> Bool)+              (isLeft :: Either ParamError Double -> Bool)             fromParam "100o" `shouldSatisfy`-              (isLeft :: Either Text Double -> Bool)+              (isLeft :: Either ParamError Double -> Bool)