diff --git a/guide.cabal b/guide.cabal index e60ca1f..174cfa0 100644 --- a/guide.cabal +++ b/guide.cabal @@ -135,7 +135,7 @@ library , stm-containers >= 0.2.14 && < 0.3 , template-haskell , text - , text-all == 0.3.* + , text-all >= 0.4.1.0 && < 0.5 , time >= 1.5 , transformers , uniplate @@ -190,7 +190,7 @@ test-suite tests , quickcheck-text < 0.2 , slave-thread , tagsoup < 1 - , text-all < 0.4 + , text-all , transformers , webdriver >= 0.8.4 && < 0.9 hs-source-dirs: tests diff --git a/src/Guide/Main.hs b/src/Guide/Main.hs index a6172a5..e083303 100644 --- a/src/Guide/Main.hs +++ b/src/Guide/Main.hs @@ -232,20 +232,20 @@ guideApp waiMetrics = do guidejs.csrfProtection.enable("$csrfTokenName", "$csrfTokenValue"); |] js <- getJS - Spock.bytes $ T.encodeUtf8 (fromJS allJSFunctions <> js <> jqueryCsrfProtection) + Spock.bytes $ T.toByteString (fromJS allJSFunctions <> js <> jqueryCsrfProtection) -- CSS Spock.get "/highlight.css" $ do setHeader "Content-Type" "text/css; charset=utf-8" - Spock.bytes $ T.encodeUtf8 (T.pack (styleToCss pygments)) + Spock.bytes $ T.toByteString (styleToCss pygments) Spock.get "/css.css" $ do setHeader "Content-Type" "text/css; charset=utf-8" css <- getCSS - Spock.bytes $ T.encodeUtf8 css + Spock.bytes $ T.toByteString css Spock.get "/admin.css" $ do setHeader "Content-Type" "text/css; charset=utf-8" css <- getCSS admincss <- liftIO $ T.readFile "static/admin.css" - Spock.bytes $ T.encodeUtf8 (css <> admincss) + Spock.bytes $ T.toByteString (css <> admincss) -- Main page Spock.get root $ @@ -331,7 +331,8 @@ loginAction = do formHtml <- protectForm loginFormView v lucidWithConfig $ renderRegister formHtml (v, Just Login {..}) -> do - loginAttempt <- dbQuery $ LoginUser loginEmail (T.encodeUtf8 loginUserPassword) + loginAttempt <- dbQuery $ + LoginUser loginEmail (T.toByteString loginUserPassword) case loginAttempt of Just user -> do modifySession (sessionUserID .~ Just (user ^. userID)) @@ -354,7 +355,8 @@ signupAction = do formHtml <- protectForm registerFormView v lucidWithConfig $ renderRegister formHtml (v, Just UserRegistration {..}) -> do - user <- makeUser registerUserName registerUserEmail (T.encodeUtf8 registerUserPassword) + user <- makeUser registerUserName registerUserEmail + (T.toByteString registerUserPassword) success <- dbUpdate $ CreateUser user if success then do @@ -442,6 +444,6 @@ installTerminationCatcher thread = void $ do -- The user won't be added if it exists already. createAdminUser :: GuideApp () createAdminUser = do - pass <- T.encodeUtf8 . _adminPassword <$> getConfig + pass <- T.toByteString . _adminPassword <$> getConfig user <- makeUser "admin" "admin@guide.aelve.com" pass void $ dbUpdate $ CreateUser (user & userIsAdmin .~ True) diff --git a/src/Guide/Markdown.hs b/src/Guide/Markdown.hs index b02041c..c50fd29 100644 --- a/src/Guide/Markdown.hs +++ b/src/Guide/Markdown.hs @@ -97,9 +97,9 @@ renderMD :: [MD.Node] -> ByteString renderMD ns -- See https://github.com/jgm/cmark/issues/147 | any isInlineNode ns = - T.encodeUtf8 . sanitize . T.concat . map (nodeToHtml []) $ ns + T.toByteString . sanitize . T.concat . map (nodeToHtml []) $ ns | otherwise = - T.encodeUtf8 . sanitize . nodeToHtml [] $ MD.Node Nothing DOCUMENT ns + T.toByteString . sanitize . nodeToHtml [] $ MD.Node Nothing DOCUMENT ns isInlineNode :: MD.Node -> Bool isInlineNode (MD.Node _ tp _) = case tp of @@ -301,11 +301,11 @@ instance Show MarkdownTree where instance A.ToJSON MarkdownInline where toJSON md = A.object [ "text" A..= (md^.mdText), - "html" A..= T.decodeUtf8 (md^.mdHtml) ] + "html" A..= T.toStrict (md^.mdHtml) ] instance A.ToJSON MarkdownBlock where toJSON md = A.object [ "text" A..= (md^.mdText), - "html" A..= T.decodeUtf8 (md^.mdHtml) ] + "html" A..= T.toStrict (md^.mdHtml) ] instance A.ToJSON MarkdownTree where toJSON md = A.object [ "text" A..= (md^.mdText) ] diff --git a/src/Guide/Utils.hs b/src/Guide/Utils.hs index 6f1c40f..aa48944 100644 --- a/src/Guide/Utils.hs +++ b/src/Guide/Utils.hs @@ -118,8 +118,8 @@ import Data.Generics.Uniplate.Data (transform) import qualified Codec.Binary.UTF8.String as UTF8 import qualified Network.URI as URI -- needed for parsing urls -import Data.Text.Encoding (encodeUtf8, decodeUtf8) -import Network.HTTP.Types (Query, parseQuery) +import Network.HTTP.Types (Query, parseQuery) + ---------------------------------------------------------------------------- -- Lists ---------------------------------------------------------------------------- @@ -269,15 +269,14 @@ showKeyword _ = "" extractQuery :: Url -> Maybe Query extractQuery url = getQuery <$> parse url where - toBS = encodeUtf8 . T.pack - getQuery = parseQuery . toBS . URI.uriQuery + getQuery = parseQuery . T.toByteString . URI.uriQuery parse = URI.parseURI . T.toString extractKeyword :: Url -> Maybe Text extractKeyword url = case extractQuery url of - Just query -> decodeUtf8 <$> lookupQuery query - Nothing -> Nothing + Just query -> T.toStrict <$> lookupQuery query + Nothing -> Nothing where lookupQuery = join . (lookup "q" <> lookup "p" <> lookup "text") @@ -289,8 +288,8 @@ toReferrerView url where uri = URI.parseURI $ T.toString url uriAuth = fromJust $ uri >>= URI.uriAuthority - domain = T.pack $ URI.uriRegName uriAuth - keyword = extractKeyword url + domain = T.toStrict $ URI.uriRegName uriAuth + keyword = extractKeyword url ---------------------------------------------------------------------------- -- IP @@ -325,7 +324,7 @@ instance SafeCopy (Uid a) where kind = base instance IsString (Uid a) where - fromString = Uid . T.pack + fromString = Uid . T.toStrict -- | Generate a random text of given length from characters @a-z@ and digits. randomText :: MonadIO m => Int -> m Text @@ -339,7 +338,7 @@ randomText n = liftIO $ do return $ if i < 10 then toEnum (fromEnum '0' + i) else toEnum (fromEnum 'a' + i - 10) xs <- replicateM (n-1) randomChar - return (T.pack (x:xs)) + return (T.toStrict (x:xs)) -- For probability tables, see -- https://en.wikipedia.org/wiki/Birthday_problem#Probability_table @@ -394,7 +393,7 @@ includeCSS url = link_ [rel_ "stylesheet", type_ "text/css", href_ url] atomFeed :: MonadIO m => Atom.Feed -> ActionCtxT ctx m () atomFeed feed = do setHeader "Content-Type" "application/atom+xml; charset=utf-8" - bytes $ T.encodeUtf8 (T.pack (XML.ppElement (Atom.xmlFeed feed))) + bytes $ T.toByteString (XML.ppElement (Atom.xmlFeed feed)) -- | Get details of the request: -- diff --git a/src/Guide/Views/Utils.hs b/src/Guide/Views/Utils.hs index 3cf2bcc..4bb4459 100644 --- a/src/Guide/Views/Utils.hs +++ b/src/Guide/Views/Utils.hs @@ -70,7 +70,6 @@ import qualified Data.Map as M -- import Data.Tree -- Text import qualified Data.Text.All as T -import qualified Data.Text.Lazy.All as TL -- digestive-functors import Text.Digestive (View) -- import NeatInterpolation @@ -87,6 +86,7 @@ import qualified System.FilePath.Find as F -- Mustache (templates) import Text.Mustache.Plus import qualified Data.Aeson as A +import qualified Data.Aeson.Text as A import qualified Data.Aeson.Encode.Pretty as A import qualified Data.ByteString.Lazy.Char8 as BS import qualified Data.Semigroup as Semigroup @@ -297,7 +297,7 @@ mustache f v = do then return (A.String "selected") else return A.Null), ("js", \[x] -> return $ - A.String . T.toStrict . TL.decodeUtf8 . A.encode $ x), + A.String . T.toStrict . A.encodeToLazyText $ x), ("trace", \xs -> do mapM_ (BS.putStrLn . A.encodePretty) xs return A.Null) ] diff --git a/stack.yaml b/stack.yaml index f5cf380..8688dea 100644 --- a/stack.yaml +++ b/stack.yaml @@ -8,6 +8,7 @@ packages: extra-dep: true extra-deps: +- text-all-0.4.1.0 - cmark-sections-0.1.0.3 - patches-vector-0.1.5.4 - fmt-0.2.0.0