Parsable UTCTime #250 (#368)

* WIP add Parsable UTCTime support

* fix test and haddocks

* fix imports

---------

Co-authored-by: Marco Zocca <[email protected]>

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

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)

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

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