From d57dc789832bbfb67d5c989b18aea96190ed0308 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Wed, 9 Jun 2010 09:48:21 +0300 Subject: [PATCH] Removed convertible-text --- Yesod.hs | 2 -- Yesod/Content.hs | 15 ++++++++------- Yesod/Contrib/Crud.hs | 6 +++--- Yesod/Contrib/Formable.hs | 6 ++++-- Yesod/Dispatch.hs | 31 +++++++++++++++++++------------ Yesod/Form.hs | 7 +++++-- Yesod/Hamlet.hs | 6 ------ Yesod/Handler.hs | 9 +++++---- Yesod/Helpers/AtomFeed.hs | 10 +++++----- Yesod/Helpers/Auth.hs | 29 +++++++++++++++-------------- Yesod/Helpers/Sitemap.hs | 8 ++++---- Yesod/Helpers/Static.hs | 2 +- Yesod/Json.hs | 8 ++++---- Yesod/Yesod.hs | 18 +++++++++--------- yesod.cabal | 2 +- 15 files changed, 83 insertions(+), 76 deletions(-) diff --git a/Yesod.hs b/Yesod.hs index 95e68086..82afafb1 100644 --- a/Yesod.hs +++ b/Yesod.hs @@ -11,7 +11,6 @@ module Yesod , module Yesod.Hamlet , module Yesod.Json , Application - , cs , liftIO , Routes ) where @@ -32,6 +31,5 @@ import Yesod.Yesod import Yesod.Handler hiding (runHandler) import Network.Wai (Application) import Yesod.Hamlet -import Data.Convertible.Text (cs) import "transformers" Control.Monad.IO.Class (liftIO) import Web.Routes.Quasi (Routes) diff --git a/Yesod/Content.hs b/Yesod/Content.hs index 7b32e414..d388d6a7 100644 --- a/Yesod/Content.hs +++ b/Yesod/Content.hs @@ -54,7 +54,6 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.Text.Lazy (Text) import qualified Data.Text as T -import Data.Convertible.Text import qualified Network.Wai as W import qualified Network.Wai.Enumerator as WE @@ -63,6 +62,10 @@ import Data.Function (on) import Data.Time import System.Locale +import qualified Data.Text.Encoding +import qualified Data.Text.Lazy.Encoding +import qualified Data.ByteString.Lazy.UTF8 + #if TEST import Test.Framework (testGroup, Test) import Test.Framework.Providers.HUnit @@ -94,13 +97,11 @@ instance ToContent B.ByteString where instance ToContent L.ByteString where toContent = swapEnum . WE.fromLBS instance ToContent T.Text where - toContent t = toContent (cs t :: B.ByteString) + toContent = toContent . Data.Text.Encoding.encodeUtf8 instance ToContent Text where - toContent lt = toContent (cs lt :: L.ByteString) + toContent = toContent . Data.Text.Lazy.Encoding.encodeUtf8 instance ToContent String where - toContent s = toContent (cs s :: L.ByteString) -instance ToContent (IO Text) where - toContent = swapEnum . WE.fromLBS' . fmap cs + toContent = toContent . Data.ByteString.Lazy.UTF8.fromString -- | A function which gives targetted representations of content based on the -- content-types the user accepts. @@ -251,7 +252,7 @@ propExt s = caseTypeByExt :: Assertion caseTypeByExt = do - TypeJavascript @=? typeByExt (ext "foo.js") + typeJavascript @=? typeByExt (ext "foo.js") typeHtml @=? typeByExt (ext "foo.html") #endif diff --git a/Yesod/Contrib/Crud.hs b/Yesod/Contrib/Crud.hs index e2a9e791..0e3fd23b 100644 --- a/Yesod/Contrib/Crud.hs +++ b/Yesod/Contrib/Crud.hs @@ -51,7 +51,7 @@ getCrudListR = do $forall items item %li %a!href=@toMaster.CrudEditR.toSinglePiece.fst.item@ - $cs.itemTitle.snd.item$ + $string.itemTitle.snd.item$ %p %a!href=@toMaster.CrudAddR@ Add new item |] @@ -102,7 +102,7 @@ getCrudDeleteR s = do applyLayout "Confirm delete" mempty [$hamlet| %form!method=post!action=@toMaster.CrudDeleteR.s@ %h1 Really delete? - %p Do you really want to delete $cs.itemTitle.item$? + %p Do you really want to delete $string.itemTitle.item$? %p %input!type=submit!value=Yes \ @@ -142,7 +142,7 @@ crudHelper title me isPost = do applyLayout title mempty [$hamlet| %p %a!href=@toMaster.CrudListR@ Return to list -%h1 $cs.title$ +%h1 $string.title$ %form!method=post %table ^form^ diff --git a/Yesod/Contrib/Formable.hs b/Yesod/Contrib/Formable.hs index 4046a976..6bef2340 100644 --- a/Yesod/Contrib/Formable.hs +++ b/Yesod/Contrib/Formable.hs @@ -14,11 +14,11 @@ import Data.Char (isAlphaNum) import Language.Haskell.TH.Syntax import Database.Persist (Table (..)) import Database.Persist.Helper (upperFirst) -import Data.Convertible.Text (cs) import Control.Monad (liftM) import Control.Arrow (first) import Data.Maybe (fromMaybe) import Data.Monoid (mempty, mappend) +import qualified Data.ByteString.Lazy.UTF8 type Env = [(String, String)] @@ -124,7 +124,9 @@ instance Fieldable [Char] where |] instance Fieldable Html where - fieldable = fmap preEscapedString . input' go . fmap (cs . renderHtml) + fieldable = fmap preEscapedString + . input' go + . fmap (Data.ByteString.Lazy.UTF8.toString . renderHtml) where go name val = [$hamlet|%textarea!name=$string.name$ $string.val$|] diff --git a/Yesod/Dispatch.hs b/Yesod/Dispatch.hs index df92d5f5..2704e60c 100644 --- a/Yesod/Dispatch.hs +++ b/Yesod/Dispatch.hs @@ -46,9 +46,11 @@ import System.Environment (getEnvironment) import qualified Data.ByteString.Char8 as B import Web.Routes (encodePathInfo) +import qualified Data.ByteString.UTF8 as S +import qualified Data.ByteString.Lazy.UTF8 as L + import Control.Concurrent.MVar import Control.Arrow ((***), first) -import Data.Convertible.Text (cs) import Data.Time @@ -230,10 +232,10 @@ toWaiApp' y segments env = do (s, hs, ct, c, sessionFinal) <- unYesodApp ya eh rr types let sessionVal = encodeSession key' exp' host sessionFinal let hs' = AddCookie (clientSessionDuration y) sessionName - (cs sessionVal) + (S.toString sessionVal) : hs hs'' = map (headerToPair getExpires) hs' - hs''' = (W.ContentType, cs ct) : hs'' + hs''' = (W.ContentType, S.fromString ct) : hs'' return $ W.Response s hs''' $ case c of ContentFile fp -> Left fp ContentEnum e -> Right $ W.buffer @@ -286,11 +288,13 @@ parseWaiRequest :: W.Request -> [(String, String)] -- ^ session -> IO Request parseWaiRequest env session' = do - let gets' = map (cs *** cs) $ parseQueryString $ W.queryString env - let reqCookie = fromMaybe B.empty $ lookup W.Cookie $ W.requestHeaders env - cookies' = map (cs *** cs) $ parseCookies reqCookie + let gets' = map (S.toString *** S.toString) + $ parseQueryString $ W.queryString env + let reqCookie = fromMaybe B.empty $ lookup W.Cookie + $ W.requestHeaders env + cookies' = map (S.toString *** S.toString) $ parseCookies reqCookie acceptLang = lookup W.AcceptLanguage $ W.requestHeaders env - langs = map cs $ maybe [] parseHttpAccept acceptLang + langs = map S.toString $ maybe [] parseHttpAccept acceptLang langs' = case lookup langKey cookies' of Nothing -> langs Just x -> x : langs @@ -302,8 +306,9 @@ parseWaiRequest env session' = do rbHelper :: W.Request -> IO RequestBodyContents rbHelper = fmap (fix1 *** map fix2) . parseRequestBody lbsSink where - fix1 = map (cs *** cs) - fix2 (x, FileInfo a b c) = (cs x, FileInfo (cs a) (cs b) c) + fix1 = map (S.toString *** S.toString) + fix2 (x, FileInfo a b c) = + (S.toString x, FileInfo a b c) -- | Produces a \"compute on demand\" value. The computation will be run once -- it is requested, and then the result will be stored. This will happen only @@ -324,12 +329,14 @@ headerToPair :: (Int -> UTCTime) -- ^ minutes -> expiration time -> (W.ResponseHeader, B.ByteString) headerToPair getExpires (AddCookie minutes key value) = let expires = getExpires minutes - in (W.SetCookie, cs $ key ++ "=" ++ value ++"; path=/; expires=" + in (W.SetCookie, S.fromString + $ key ++ "=" ++ value ++"; path=/; expires=" ++ formatW3 expires) headerToPair _ (DeleteCookie key) = - (W.SetCookie, cs $ + (W.SetCookie, S.fromString $ key ++ "=; path=/; expires=Thu, 01-Jan-1970 00:00:00 GMT") -headerToPair _ (Header key value) = (W.responseHeaderFromBS $ cs key, cs value) +headerToPair _ (Header key value) = + (W.responseHeaderFromBS $ S.fromString key, S.fromString value) encodeSession :: Key -> UTCTime -- ^ expire time diff --git a/Yesod/Form.hs b/Yesod/Form.hs index acacbb86..03f9c0fc 100644 --- a/Yesod/Form.hs +++ b/Yesod/Form.hs @@ -24,7 +24,6 @@ import Yesod.Request import Yesod.Handler import Control.Applicative hiding (optional) import Data.Time (Day) -import Data.Convertible.Text import Data.Maybe (fromMaybe) import "transformers" Control.Monad.IO.Class import Yesod.Internal @@ -107,7 +106,11 @@ notEmpty = applyForm $ \pv -> else Right pv checkDay :: Form ParamValue -> Form Day -checkDay = applyForm $ attempt (const (Left "Invalid day")) Right . ca +checkDay = applyForm $ maybe (Left "Invalid day") Right . readMay + where + readMay s = case reads s of + (x, _):_ -> Just x + [] -> Nothing checkBool :: Form [ParamValue] -> Form Bool checkBool = applyForm $ \pv -> Right $ case pv of diff --git a/Yesod/Hamlet.hs b/Yesod/Hamlet.hs index e2c7f971..41efd060 100644 --- a/Yesod/Hamlet.hs +++ b/Yesod/Hamlet.hs @@ -17,7 +17,6 @@ module Yesod.Hamlet import Text.Hamlet import Yesod.Content import Yesod.Handler -import Data.Convertible.Text import Web.Routes.Quasi (Routes) -- | Content for a web page. By providing this datatype, we can easily create @@ -40,8 +39,3 @@ hamletToContent h = do -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'. hamletToRepHtml :: Hamlet (Routes master) -> GHandler sub master RepHtml hamletToRepHtml = fmap RepHtml . hamletToContent - -instance ConvertSuccess String (Hamlet url) where - convertSuccess = const . string -instance ConvertSuccess String Html where - convertSuccess = string diff --git a/Yesod/Handler.hs b/Yesod/Handler.hs index 5364398e..2bd5efff 100644 --- a/Yesod/Handler.hs +++ b/Yesod/Handler.hs @@ -84,8 +84,9 @@ import System.IO import qualified Data.ByteString.Lazy as BL import qualified Network.Wai as W import Control.Monad.Attempt +import Data.ByteString.UTF8 (toString) +import qualified Data.ByteString.Lazy.UTF8 as L -import Data.Convertible.Text (cs) import Text.Hamlet import Numeric (showIntAtBase) import Data.Char (ord, chr) @@ -326,7 +327,7 @@ msgKey = "_MSG" -- -- See 'getMessage'. setMessage :: Html -> GHandler sub master () -setMessage = setSession msgKey . cs . renderHtml +setMessage = setSession msgKey . L.toString . renderHtml -- | Gets the message in the user's session, if available, and then clears the -- variable. @@ -335,7 +336,7 @@ setMessage = setSession msgKey . cs . renderHtml getMessage :: GHandler sub master (Maybe Html) getMessage = do clearSession msgKey - fmap (fmap $ preEscapedString . cs) $ lookupSession msgKey + fmap (fmap preEscapedString) $ lookupSession msgKey -- | Bypass remaining handler code and output the given file. -- @@ -352,7 +353,7 @@ notFound = failure NotFound badMethod :: (RequestReader m, Failure ErrorResponse m) => m a badMethod = do w <- waiRequest - failure $ BadMethod $ cs $ W.methodToBS $ W.requestMethod w + failure $ BadMethod $ toString $ W.methodToBS $ W.requestMethod w -- | Return a 403 permission denied page. permissionDenied :: Failure ErrorResponse m => m a diff --git a/Yesod/Helpers/AtomFeed.hs b/Yesod/Helpers/AtomFeed.hs index eabc96c1..f108eaba 100644 --- a/Yesod/Helpers/AtomFeed.hs +++ b/Yesod/Helpers/AtomFeed.hs @@ -48,16 +48,16 @@ data AtomFeedEntry url = AtomFeedEntry } xmlns :: AtomFeed url -> Html -xmlns _ = cs "http://www.w3.org/2005/Atom" +xmlns _ = preEscapedString "http://www.w3.org/2005/Atom" template :: AtomFeed url -> Hamlet url template arg = [$xhamlet| %feed!xmlns=$xmlns.arg$ - %title $cs.atomTitle.arg$ + %title $string.atomTitle.arg$ %link!rel=self!href=@atomLinkSelf.arg@ %link!href=@atomLinkHome.arg@ - %updated $cs.formatW3.atomUpdated.arg$ + %updated $string.formatW3.atomUpdated.arg$ %id @atomLinkHome.arg@ $forall atomEntries.arg entry ^entryTemplate.entry^ @@ -68,7 +68,7 @@ entryTemplate arg = [$xhamlet| %entry %id @atomEntryLink.arg@ %link!href=@atomEntryLink.arg@ - %updated $cs.formatW3.atomEntryUpdated.arg$ - %title $cs.atomEntryTitle.arg$ + %updated $string.formatW3.atomEntryUpdated.arg$ + %title $string.atomEntryTitle.arg$ %content!type=html $cdata.atomEntryContent.arg$ |] diff --git a/Yesod/Helpers/Auth.hs b/Yesod/Helpers/Auth.hs index 72f628ab..c52da2d8 100644 --- a/Yesod/Helpers/Auth.hs +++ b/Yesod/Helpers/Auth.hs @@ -50,6 +50,7 @@ import Control.Concurrent.MVar import System.IO import Control.Monad.Attempt import Data.Monoid (mempty) +import Data.ByteString.Lazy.UTF8 (fromString) class Yesod master => YesodAuth master where -- | Default destination on successful login or logout, if no other @@ -131,8 +132,8 @@ setCreds creds extra = do -- | Retrieves user credentials, if user is authenticated. maybeCreds :: RequestReader r => r (Maybe Creds) maybeCreds = do - mcs <- lookupSession credsKey - return $ mcs >>= readMay + mstring <- lookupSession credsKey + return $ mstring >>= readMay where readMay x = case reads x of (y, _):_ -> Just y @@ -188,7 +189,7 @@ getOpenIdForward = do res <- runAttemptT $ OpenId.getForwardUrl oid complete attempt (\err -> do - setMessage $ cs $ show err + setMessage $ string $ show err redirect RedirectTemporary $ toMaster OpenIdR) (redirectString RedirectTemporary) res @@ -201,7 +202,7 @@ getOpenIdComplete = do res <- runAttemptT $ OpenId.authenticate gets' toMaster <- getRouteToMaster let onFailure err = do - setMessage $ cs $ show err + setMessage $ string $ show err redirect RedirectTemporary $ toMaster OpenIdR let onSuccess (OpenId.Identifier ident) = do y <- getYesod @@ -255,12 +256,12 @@ getCheck = do $if isNothing.creds %p Not logged in $maybe creds c - %p Logged in as $cs.credsIdent.c$ + %p Logged in as $string.credsIdent.c$ |] json creds = jsonMap - [ ("ident", jsonScalar $ maybe (cs "") (cs . credsIdent) creds) - , ("displayName", jsonScalar $ cs $ fromMaybe "" + [ ("ident", jsonScalar $ maybe (string "") (string . credsIdent) creds) + , ("displayName", jsonScalar $ string $ fromMaybe "" $ creds >>= credsDisplayName) ] @@ -315,7 +316,7 @@ postEmailRegisterR = do let verUrl = render $ tm $ EmailVerifyR lid verKey liftIO $ sendVerifyEmail ae email verKey verUrl applyLayout "Confirmation e-mail sent" mempty [$hamlet| -%p A confirmation e-mail has been sent to $cs.email$. +%p A confirmation e-mail has been sent to $string.email$. |] checkEmail :: Form ParamValue -> Form ParamValue @@ -381,7 +382,7 @@ postEmailLoginR = do setCreds (Creds email AuthEmail (Just email) Nothing (Just lid)) [] redirectUltDest RedirectTemporary $ defaultDest y Nothing -> do - setMessage $ cs "Invalid email/password combination" + setMessage $ string "Invalid email/password combination" toMaster <- getRouteToMaster redirect RedirectTemporary $ toMaster EmailLoginR @@ -393,7 +394,7 @@ getEmailPasswordR = do case mcreds of Just (Creds _ AuthEmail _ _ (Just _)) -> return () _ -> do - setMessage $ cs "You must be logged in to set a password" + setMessage $ string "You must be logged in to set a password" redirect RedirectTemporary $ toMaster EmailLoginR msg <- getMessage applyLayout "Set password" mempty [$hamlet| @@ -423,17 +424,17 @@ postEmailPasswordR = do <*> notEmpty (required $ input "confirm") toMaster <- getRouteToMaster when (new /= confirm) $ do - setMessage $ cs "Passwords did not match, please try again" + setMessage $ string "Passwords did not match, please try again" redirect RedirectTemporary $ toMaster EmailPasswordR mcreds <- maybeCreds lid <- case mcreds of Just (Creds _ AuthEmail _ _ (Just lid)) -> return lid _ -> do - setMessage $ cs "You must be logged in to set a password" + setMessage $ string "You must be logged in to set a password" redirect RedirectTemporary $ toMaster EmailLoginR salted <- liftIO $ saltPass new liftIO $ setPassword ae lid salted - setMessage $ cs "Password updated" + setMessage $ string "Password updated" redirect RedirectTemporary $ toMaster EmailLoginR saltLength :: Int @@ -453,7 +454,7 @@ saltPass pass = do return $ saltPass' salt pass saltPass' :: String -> String -> String -saltPass' salt pass = salt ++ show (md5 $ cs $ salt ++ pass) +saltPass' salt pass = salt ++ show (md5 $ fromString $ salt ++ pass) inMemoryEmailSettings :: IO AuthEmailSettings inMemoryEmailSettings = do diff --git a/Yesod/Helpers/Sitemap.hs b/Yesod/Helpers/Sitemap.hs index 89890e32..7ac9256b 100644 --- a/Yesod/Helpers/Sitemap.hs +++ b/Yesod/Helpers/Sitemap.hs @@ -51,7 +51,7 @@ data SitemapUrl url = SitemapUrl } sitemapNS :: Html -sitemapNS = cs "http://www.sitemaps.org/schemas/sitemap/0.9" +sitemapNS = string "http://www.sitemaps.org/schemas/sitemap/0.9" template :: [SitemapUrl url] -> Hamlet url template urls = [$hamlet| @@ -59,9 +59,9 @@ template urls = [$hamlet| $forall urls url %url %loc @sitemapLoc.url@ - %lastmod $cs.formatW3.sitemapLastMod.url$ - %changefreq $cs.showFreq.sitemapChangeFreq.url$ - %priority $cs.show.priority.url$ + %lastmod $string.formatW3.sitemapLastMod.url$ + %changefreq $string.showFreq.sitemapChangeFreq.url$ + %priority $string.show.priority.url$ |] sitemap :: [SitemapUrl (Routes master)] -> GHandler sub master RepXml diff --git a/Yesod/Helpers/Static.hs b/Yesod/Helpers/Static.hs index 86951052..7157b358 100644 --- a/Yesod/Helpers/Static.hs +++ b/Yesod/Helpers/Static.hs @@ -80,7 +80,7 @@ getStaticRoute fp' = do case content of Nothing -> notFound Just (Left fp'') -> sendFile (typeByExt $ ext fp'') fp'' - Just (Right bs) -> return [(typeByExt $ ext fp, cs bs)] + Just (Right bs) -> return [(typeByExt $ ext fp, bs)] where isUnsafe [] = True isUnsafe ('.':_) = True diff --git a/Yesod/Json.hs b/Yesod/Json.hs index 51716943..0629f122 100644 --- a/Yesod/Json.hs +++ b/Yesod/Json.hs @@ -16,14 +16,14 @@ module Yesod.Json ) where -import qualified Data.ByteString.Char8 as S8 +import qualified Data.ByteString.Char8 as S +import qualified Data.ByteString.Lazy.Char8 as L import Data.Char (isControl) import Yesod.Hamlet import Yesod.Handler import Web.Routes.Quasi (Routes) import Numeric (showHex) import Data.Monoid (Monoid (..)) -import Data.Convertible.Text (cs) import Text.Hamlet #if TEST @@ -66,11 +66,11 @@ jsonToRepJson = fmap RepJson . jsonToContent jsonScalar :: Html -> Json jsonScalar s = Json $ mconcat [ preEscapedString "\"" - , preEscapedString $ encodeJson $ cs $ renderHtml s + , unsafeBytestring $ S.concat $ L.toChunks $ encodeJson $ renderHtml s , preEscapedString "\"" ] where - encodeJson = concatMap encodeJsonChar + encodeJson = L.concatMap (L.pack . encodeJsonChar) encodeJsonChar '\b' = "\\b" encodeJsonChar '\f' = "\\f" diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs index 6afa19fc..b75eee0d 100644 --- a/Yesod/Yesod.hs +++ b/Yesod/Yesod.hs @@ -16,12 +16,12 @@ import Yesod.Content import Yesod.Request import Yesod.Hamlet import Yesod.Handler -import Data.Convertible.Text import qualified Network.Wai as W import Yesod.Json import Yesod.Internal import Web.ClientSession (getKey, defaultKeyFile, Key) import Data.Monoid (mempty) +import Data.ByteString.UTF8 (toString) import Web.Routes.Quasi (QuasiSite (..), Routes) @@ -99,7 +99,7 @@ applyLayout :: Yesod master -> GHandler sub master RepHtml applyLayout t h b = RepHtml `fmap` defaultLayout PageContent - { pageTitle = cs t + { pageTitle = string t , pageHead = h , pageBody = b } @@ -114,7 +114,7 @@ applyLayoutJson :: Yesod master -> GHandler sub master RepHtmlJson applyLayoutJson t h html json = do html' <- defaultLayout PageContent - { pageTitle = cs t + { pageTitle = string t , pageHead = h , pageBody = html } @@ -135,30 +135,30 @@ defaultErrorHandler NotFound = do r <- waiRequest applyLayout' "Not Found" $ [$hamlet| %h1 Not Found -%p $string.cs.pathInfo.r$ +%p $string.toString.pathInfo.r$ |] where pathInfo = W.pathInfo defaultErrorHandler (PermissionDenied msg) = applyLayout' "Permission Denied" $ [$hamlet| %h1 Permission denied -%p $cs.msg$ +%p $string.msg$ |] defaultErrorHandler (InvalidArgs ia) = applyLayout' "Invalid Arguments" $ [$hamlet| %h1 Invalid Arguments %dl $forall ia pair - %dt $cs.fst.pair$ - %dd $cs.snd.pair$ + %dt $string.fst.pair$ + %dd $string.snd.pair$ |] defaultErrorHandler (InternalError e) = applyLayout' "Internal Server Error" $ [$hamlet| %h1 Internal Server Error -%p $cs.e$ +%p $string.e$ |] defaultErrorHandler (BadMethod m) = applyLayout' "Bad Method" $ [$hamlet| %h1 Method Not Supported -%p Method "$cs.m$" not supported +%p Method "$string.m$" not supported |] diff --git a/yesod.cabal b/yesod.cabal index d475db1b..182222f5 100644 --- a/yesod.cabal +++ b/yesod.cabal @@ -38,7 +38,7 @@ library bytestring >= 0.9.1.4 && < 0.10, directory >= 1 && < 1.1, text >= 0.5 && < 0.8, - convertible-text >= 0.3.0 && < 0.4, + utf8-string >= 0.3.4 && < 0.4, template-haskell >= 2.4 && < 2.5, web-routes >= 0.22 && < 0.23, web-routes-quasi >= 0.4 && < 0.5,