Use newer text-all with bytestring encoding/decoding

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

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)

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) ]

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:
 --

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) ]

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