diff --git a/guide.cabal b/guide.cabal index 5fd8a24..3edaf59 100644 --- a/guide.cabal +++ b/guide.cabal @@ -11,7 +11,7 @@ author: Artyom maintainer: yom@artyom.me -- copyright: category: Web -tested-with: GHC == 8.0.1 +tested-with: GHC == 8.2.2 build-type: Custom extra-source-files: CHANGELOG.md @@ -85,11 +85,11 @@ library Imports build-depends: Spock , Spock-digestive - , Spock-lucid == 0.3.* + , Spock-lucid == 0.4.* , acid-state == 0.14.* - , aeson == 1.0.* + , aeson == 1.2.* , aeson-pretty - , base >=4.9 && <4.10 + , base == 4.10.* , base-prelude , bytestring , cereal @@ -105,7 +105,7 @@ library , ekg-core , exceptions , extra - , feed >= 0.3.11 && < 0.4 + , feed == 1.0.* , filemanip == 0.3.6.* , filepath , fmt == 0.4.* @@ -122,7 +122,7 @@ library , ilist , iproute == 1.7.* , lucid >= 2.9.5 && < 3 - , megaparsec == 5.* + , megaparsec == 6.* , microlens-platform >= 0.3.2 , mmorph == 1.* , mtl >= 2.1.1 @@ -134,7 +134,7 @@ library , reroute , safe , safecopy - , safecopy-migrate + , safecopy-migrate == 0.2.* , say , scrypt , servant-generic @@ -159,7 +159,8 @@ library , wai-middleware-static , wai-cors , warp - , xml + , xml-conduit + , xml-types , xss-sanitize ghc-options: -Wall -fno-warn-unused-do-bind hs-source-dirs: src @@ -185,7 +186,7 @@ test-suite tests MergeSpec Selenium type: exitcode-stdio-1.0 - build-depends: QuickCheck < 2.10 + build-depends: QuickCheck < 3 , base < 5 , base-prelude , cmark diff --git a/src/Guide/Api/Server.hs b/src/Guide/Api/Server.hs index c7a548c..10d3805 100644 --- a/src/Guide/Api/Server.hs +++ b/src/Guide/Api/Server.hs @@ -17,7 +17,7 @@ import Servant import Servant.Generic import Network.Wai.Handler.Warp (run) import Network.Wai (Middleware) -import Network.Wai.Middleware.Cors (CorsResourcePolicy (..), cors +import Network.Wai.Middleware.Cors (CorsResourcePolicy (..), cors , corsOrigins, simpleCorsResourcePolicy) -- putStrLn that works well with concurrency diff --git a/src/Guide/Handlers.hs b/src/Guide/Handlers.hs index b29a67d..606dc75 100644 --- a/src/Guide/Handlers.hs +++ b/src/Guide/Handlers.hs @@ -26,7 +26,6 @@ import qualified Text.Feed.Util as Feed import qualified Text.Atom.Feed as Atom -- Text import qualified Data.Text.All as T -import qualified Data.Text.Lazy.All as TL -- Web import Web.Spock hiding (head, get, renderRoute, text) import qualified Web.Spock as Spock @@ -360,16 +359,15 @@ otherMethods = do where cmp = comparing (^.created) <> comparing (^.uid) let route = "feed" categoryVar let feedUrl = baseUrl // Spock.renderRoute route (category^.uid) - feedTitle = Atom.TextString (T.unpack (category^.title) ++ - " – Haskell – Aelve Guide") + feedTitle = Atom.TextString (category^.title <> " – Haskell – Aelve Guide") feedLastUpdate = case sortedItems of - (item:_) -> Feed.toFeedDateStringUTC Feed.AtomKind (item^.created) - _ -> "" - let feedBase = Atom.nullFeed (T.unpack feedUrl) feedTitle feedLastUpdate + item:_ -> Feed.toFeedDateStringUTC Feed.AtomKind (item^.created) + _ -> "" + let feedBase = Atom.nullFeed feedUrl feedTitle (T.toStrict feedLastUpdate) entries <- liftIO $ mapM (itemToFeedEntry baseUrl category) sortedItems atomFeed $ feedBase { Atom.feedEntries = entries, - Atom.feedLinks = [Atom.nullLink (T.unpack feedUrl)] } + Atom.feedLinks = [Atom.nullLink feedUrl] } adminMethods :: AdminM ctx () adminMethods = do @@ -426,12 +424,12 @@ itemToFeedEntry itemToFeedEntry baseUrl category item = do entryContent <- Lucid.renderTextT (renderItemForFeed category item) return entryBase { - Atom.entryLinks = [Atom.nullLink (T.unpack entryLink)], - Atom.entryContent = Just (Atom.HTMLContent (TL.unpack entryContent)) } + Atom.entryLinks = [Atom.nullLink entryLink], + Atom.entryContent = Just (Atom.HTMLContent (T.toStrict entryContent)) } where entryLink = baseUrl // format "{}#item-{}" (categorySlug category) (item^.uid) entryBase = Atom.nullEntry - (T.unpack (uidToText (item^.uid))) - (Atom.TextString (T.unpack (item^.name))) - (Feed.toFeedDateStringUTC Feed.AtomKind (item^.created)) + (uidToText (item^.uid)) + (Atom.TextString (item^.name)) + (T.toStrict (Feed.toFeedDateStringUTC Feed.AtomKind (item^.created))) diff --git a/src/Guide/Markdown.hs b/src/Guide/Markdown.hs index 948b934..89644eb 100644 --- a/src/Guide/Markdown.hs +++ b/src/Guide/Markdown.hs @@ -38,7 +38,7 @@ module Guide.Markdown where -import Imports +import Imports hiding (some) -- Text import qualified Data.Text.All as T @@ -47,7 +47,7 @@ import qualified Data.ByteString.Lazy as BSL import qualified Data.ByteString as BS -- Parsing import Text.Megaparsec hiding (State) -import Text.Megaparsec.Text +import Text.Megaparsec.Char -- JSON import qualified Data.Aeson as A -- HTML @@ -230,7 +230,7 @@ parseLink = either (Left . show) Right . parse p "" shortcut = some (alphaNumChar <|> char '-') opt = char '(' *> some (noneOf [')']) <* char ')' text = char ':' *> some anyChar - p :: Parser (Text, Maybe Text, Maybe Text) + p :: Parsec Void Text (Text, Maybe Text, Maybe Text) p = do char '@' (,,) <$> T.pack <$> shortcut diff --git a/src/Guide/Types/Core.hs b/src/Guide/Types/Core.hs index d0bf3ce..ff536f0 100644 --- a/src/Guide/Types/Core.hs +++ b/src/Guide/Types/Core.hs @@ -65,7 +65,6 @@ import qualified Data.Text.All as T import qualified Data.Set as S -- JSON import qualified Data.Aeson as A -import qualified Data.Aeson.Types as A -- acid-state import Data.SafeCopy hiding (kind) import Data.SafeCopy.Migrate diff --git a/src/Guide/Types/Session.hs b/src/Guide/Types/Session.hs index c33953c..062ac0d 100644 --- a/src/Guide/Types/Session.hs +++ b/src/Guide/Types/Session.hs @@ -71,9 +71,9 @@ unwrapSession (GuideSession {..}) = Spock.Session { } wrapSession :: SpockSession conn st -> GuideSession -wrapSession (Spock.Session {..}) = GuideSession { - _sess_id = sess_id, - _sess_csrfToken = sess_csrfToken, - _sess_validUntil = sess_validUntil, - _sess_data = sess_data +wrapSession s = GuideSession { + _sess_id = Spock.sess_id s, + _sess_csrfToken = Spock.sess_csrfToken s, + _sess_validUntil = Spock.sess_validUntil s, + _sess_data = Spock.sess_data s } diff --git a/src/Guide/Utils.hs b/src/Guide/Utils.hs index c0d941d..23a9538 100644 --- a/src/Guide/Utils.hs +++ b/src/Guide/Utils.hs @@ -102,7 +102,8 @@ import qualified Network.Wai as Wai -- Feeds import qualified Text.Atom.Feed as Atom import qualified Text.Atom.Feed.Export as Atom -import qualified Text.XML.Light.Output as XML +import qualified Text.XML as XMLC +import qualified Data.XML.Types as XML -- acid-state import Data.SafeCopy -- Template Haskell @@ -445,7 +446,8 @@ 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.toByteString (XML.ppElement (Atom.xmlFeed feed)) + lazyBytes $ either (const "") (XMLC.renderLBS XMLC.def) $ XMLC.fromXMLDocument $ + XML.Document (XML.Prologue [] Nothing []) (Atom.xmlFeed feed) [] -- | Get details of the request: -- diff --git a/src/Guide/Views/Utils.hs b/src/Guide/Views/Utils.hs index f91eb71..526af52 100644 --- a/src/Guide/Views/Utils.hs +++ b/src/Guide/Views/Utils.hs @@ -58,7 +58,7 @@ module Guide.Views.Utils where -import Imports +import Imports hiding (some) -- Web import Web.Spock @@ -90,7 +90,7 @@ import qualified Data.ByteString.Lazy.Char8 as BS import qualified Data.Semigroup as Semigroup import qualified Data.List.NonEmpty as NonEmpty import Text.Megaparsec -import Text.Megaparsec.Text +import Text.Megaparsec.Char import Guide.App -- import Guide.Config @@ -304,7 +304,7 @@ mustache f v = do error "View.mustache: no HTML templates found in templates/" parsed <- for templates $ \(tname, t) -> do let pname = fromString (T.unpack tname) - case compileMustacheText pname (T.toLazy t) of + case compileMustacheText pname t of Left e -> error $ printf "View.mustache: when parsing %s: %s" tname (parseErrorPretty e) Right template -> return template @@ -340,7 +340,7 @@ readWidget fp = liftIO $ do go (x:y:xs) = (T.strip (last x), unlinesSection (init y)) : go (y : xs) go _ = error $ "View.readWidget: couldn't read " ++ fp let sections = go (splitWhen isDivide (T.lines s)) - let sectionTypeP :: Parser SectionType + let sectionTypeP :: Parsec Void Text SectionType sectionTypeP = choice [ do string "HTML" HTML_ <$> choice [ diff --git a/src/Imports.hs b/src/Imports.hs index 1d3bd29..a9b8a3e 100644 --- a/src/Imports.hs +++ b/src/Imports.hs @@ -14,14 +14,13 @@ where import BasePrelude as X - hiding (Category, GeneralCategory, lazy, (&), Handler) + hiding (Category, GeneralCategory, lazy, Handler, diff, option) -- Lists import Data.List.Extra as X (dropEnd, takeEnd) import Data.List.Index as X -- Lenses import Lens.Micro.Platform as X -- Monads and monad transformers -import Control.Monad.IO.Class as X import Control.Monad.Reader as X import Control.Monad.State as X import Control.Monad.Except as X diff --git a/stack.yaml b/stack.yaml index fc2b6ba..988ae66 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,24 +1,22 @@ -resolver: lts-8.13 +resolver: lts-11.13 packages: - location: . -- location: - git: https://github.com/aelve/stache-plus - commit: 789aeabbf8069dec80647160f127d047e8f5a330 - extra-dep: true -- location: - git: https://github.com/aelve/safecopy-migrate - commit: 26e5f8c7f62ebce66ef19e5bd573af21c16fe2b1 - extra-dep: true nix: shell-file: shell.nix extra-deps: -- text-all-0.4.1.0 -- cmark-sections-0.3.0 -- patches-vector-0.1.5.4 +- text-all-0.4.2 +- cmark-sections-0.3.0.1 - fmt-0.4.0.0 - Spock-digestive-0.3.0.0 -- digestive-functors-0.8.2.0 -- servant-generic-0.1.0.0 +- digestive-functors-0.8.4.0 +- servant-generic-0.1.0.3 +- acid-state-0.14.3 +- git: https://github.com/neongreen/patches-vector + commit: 9bb704cf7f14cff9ef76a5d177e4e56ceee24705 +- git: https://github.com/aelve/stache-plus + commit: e2a8d986bd4014f889d3fa60a64e8db0ea199885 +- git: https://github.com/aelve/safecopy-migrate + commit: c401315122f04624e5e848d77f9eaa948e38c21b diff --git a/tests/Selenium.hs b/tests/Selenium.hs index 00e2274..81e3fb9 100644 --- a/tests/Selenium.hs +++ b/tests/Selenium.hs @@ -56,11 +56,10 @@ module Selenium where -import BasePrelude hiding (catch, bracket) +import BasePrelude hiding (catch, bracket, (:|)) -- Lenses import Lens.Micro.Platform -- Monads -import Control.Monad.IO.Class import Control.Monad.Loops -- Containers import qualified Data.Set as Set diff --git a/tests/WebSpec.hs b/tests/WebSpec.hs index decad7f..d9b8315 100644 --- a/tests/WebSpec.hs +++ b/tests/WebSpec.hs @@ -2,6 +2,7 @@ {-# LANGUAGE IncoherentInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE MonoLocalBinds #-} module WebSpec (tests) where @@ -9,7 +10,6 @@ module WebSpec (tests) where import BasePrelude hiding (catch, bracket) -- Monads -import Control.Monad.IO.Class import Control.Monad.Loops -- Concurrency import qualified SlaveThread as Slave