diff --git a/Web/Scotty/Action.hs b/Web/Scotty/Action.hs index d5da953..f625d6c 100644 --- a/Web/Scotty/Action.hs +++ b/Web/Scotty/Action.hs @@ -80,6 +80,8 @@ import qualified Data.Text as T import Data.Text.Encoding as STE import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLE +import Data.Time (UTCTime) +import Data.Time.Format (parseTimeM, defaultTimeLocale) import Data.Word import Network.HTTP.Types @@ -413,7 +415,7 @@ paramWith toError f k = do -- -- NB : Doesn't throw exceptions. -- --- /Since: FIXME/ +-- /Since: 0.21/ paramWithMaybe :: (Monad m, Parsable b) => (ActionEnv -> [Param]) -> T.Text -- ^ parameter name @@ -525,6 +527,18 @@ instance Parsable Word32 where parseParam = readEither instance Parsable Word64 where parseParam = readEither instance Parsable Natural where parseParam = readEither +-- | parse a UTCTime timestamp formatted as a ISO 8601 timestamp: +-- +-- @yyyy-mm-ddThh:mm:ssZ@ , where the seconds can have a decimal part with up to 12 digits and no trailing zeros. +instance Parsable UTCTime where + parseParam t = + let + fmt = "%FT%T%QZ" + in + case parseTimeM True defaultTimeLocale fmt (TL.unpack t) of + Just d -> Right d + _ -> Left $ "parseParam UTCTime: no parse of \"" <> t <> "\"" + -- | Useful for creating 'Parsable' instances for things that already implement 'Read'. Ex: -- -- > instance Parsable Int where parseParam = readEither diff --git a/changelog.md b/changelog.md index 26eacbd..0c35eed 100644 --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,7 @@ ## next [????.??.??] -## 0.21.1 +### New +* add `instance Parsable UTCTime` (#250) ### Fixes * Path parameters with value matching the parameter name prefixed by colon will properly populate `pathParams` with their literal value : `/:param` will match `/:param` and add a `Param` with value `("param", ":param")` (#301) diff --git a/scotty.cabal b/scotty.cabal index 31749af..c3b0b14 100644 --- a/scotty.cabal +++ b/scotty.cabal @@ -119,6 +119,7 @@ test-suite spec network, scotty, text, + time, wai build-tool-depends: hspec-discover:hspec-discover == 2.* GHC-options: -Wall -threaded -fno-warn-orphans diff --git a/test/Web/ScottySpec.hs b/test/Web/ScottySpec.hs index 1fb3ee7..fcbe860 100644 --- a/test/Web/ScottySpec.hs +++ b/test/Web/ScottySpec.hs @@ -10,6 +10,10 @@ import Data.Char import Data.String import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLE +import Data.Time (UTCTime(..)) +import Data.Time.Calendar (fromGregorian) +import Data.Time.Clock (secondsToDiffTime) + import Network.HTTP.Types import Network.Wai (Application, Request(queryString), responseLBS) import qualified Control.Exception.Lifted as EL @@ -152,7 +156,6 @@ spec = do it "returns query parameter with given name" $ do get "/search" `shouldRespondWith` "haskell" - describe "ActionM" $ do context "MonadBaseControl instance" $ do withApp (Scotty.get "/" $ (undefined `EL.catch` ((\_ -> html "") :: E.SomeException -> ActionM ()))) $ do @@ -190,22 +193,30 @@ spec = do it "Responds with a 302 Redirect" $ do get "/a" `shouldRespondWith` 302 { matchHeaders = ["Location" <:> "/b"] } + describe "Parsable" $ do + it "parses a UTCTime string" $ do + parseParam "2023-12-18T00:38:00Z" `shouldBe` Right (UTCTime (fromGregorian 2023 12 18) (secondsToDiffTime (60 * 38)) ) + describe "captureParam" $ do withApp ( do - Scotty.matchAny "/search/:q" $ do + Scotty.get "/search/:q" $ do _ :: Int <- captureParam "q" text "int" - Scotty.matchAny "/search/:q" $ do + Scotty.get "/search/:q" $ do _ :: String <- captureParam "q" text "string" + Scotty.get "/search-time/:q" $ do + t :: UTCTime <- captureParam "q" + text $ TL.pack (show t) ) $ do it "responds with 200 OK iff at least one route matches at the right type" $ do get "/search/42" `shouldRespondWith` 200 { matchBody = "int" } get "/search/potato" `shouldRespondWith` 200 { matchBody = "string" } + get "/search-time/2023-12-18T00:38:00Z" `shouldRespondWith` 200 {matchBody = "2023-12-18 00:38:00 UTC"} withApp ( do - Scotty.matchAny "/search/:q" $ do + Scotty.get "/search/:q" $ do v <- captureParam "q" json (v :: Int) ) $ do @@ -227,7 +238,7 @@ spec = do get "/search/xxx" `shouldRespondWith` 200 { matchBody = "z"} describe "queryParam" $ do - withApp (Scotty.matchAny "/search" $ queryParam "query" >>= text) $ do + withApp (Scotty.get "/search" $ queryParam "query" >>= text) $ do it "returns query parameter with given name" $ do get "/search?query=haskell" `shouldRespondWith` "haskell" withApp (Scotty.matchAny "/search" (do