Upgrade to GHC 8 and LTS 10.10

INSTALL.md

@@ -78,9 +78,9 @@ As of May 14, 2018, what you need to do is as follows:
     $ darcs clone $HUB/hit-graph
     $ darcs clone $HUB/hit-harder
     $ darcs clone $HUB/hit-network
-    $ darcs clone $VERVIS/darcs-rev --to-hash 30ab5896e53321105c36a028e451b93c98e0345b
+    $ darcs clone $VERVIS/darcs-rev
     $ darcs clone $VERVIS/ssh
-    $ darcs clone $VERVIS/persistent-migration --to-hash 992e059a3b8cc039d555ad31622174133a0918bc
+    $ darcs clone $VERVIS/persistent-migration
     $ darcs clone $VERVIS/persistent-email-addres
     $ darcs clone $VERVIS/yesod-mail-send --to-hash 2800294a41daf57cd420710bc79c8c9b06c0d3dd
 

src/Data/ByteString/Local.hs

@@ -1,6 +1,6 @@
 {- This file is part of Vervis.
  -
- - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -17,7 +17,6 @@
 
 module Data.ByteString.Local
     ( fromDecimal
-    , stripPrefix
     )
 where
 
@@ -41,11 +40,3 @@ fromDecimal s =
     if (not . B.null) s && B.all (\ b -> 48 <= b && b <= 57) s
         then Just $ B.foldl' (\ n b -> 10 * n + fromIntegral b - 48) 0 s
         else Nothing
-
-#if !(MIN_VERSION_bytestring(0,10,8))
-stripPrefix :: ByteString -> ByteString -> Maybe ByteString
-stripPrefix p b =
-    if p `B.isPrefixOf` b
-        then Just $ B.drop (B.length p) b
-        else Nothing
-#endif

src/Database/Persist/Local/Class/PersistEntityGraph.hs

@@ -40,6 +40,6 @@ class (PersistEntityGraph n e, PersistField (PersistEntityGraphSelector n e))
             :: Proxy (n, e) -> EntityField n (PersistEntityGraphSelector n e)
 
 class PersistEntityGraphSelect n e => PersistEntityGraphNumbered n e where
-    numberParam :: n -> Int
+    numberParam :: Proxy (n, e) -> n -> Int
-    numberField :: EntityField n Int
+    numberField :: Proxy (n, e) -> EntityField n Int
-    uniqueNode  :: PersistEntityGraphSelector n e -> Int -> Unique n
+    uniqueNode  :: Proxy (n, e) -> PersistEntityGraphSelector n e -> Int -> Unique n

src/Database/Persist/Local/Class/PersistQueryForest.hs

@@ -46,7 +46,7 @@ class PersistQuery backend => PersistQueryForest backend where
     -- | Update individual fields on any record in the transitive closure and
     -- matching the given criterion.
     updateForestWhere
-        :: (MonadIO m, PersistEntity val, backend ~ PersistEntityBackend val)
+        :: (MonadIO m, PersistRecordBackend val backend)
         => RecursionDirection
         -> EntityField val (Maybe (Key val))
         -> Key val
@@ -57,7 +57,7 @@ class PersistQuery backend => PersistQueryForest backend where
     -- | Delete all records in the transitive closure which match the given
     -- criterion.
     deleteForestWhere
-        :: (MonadIO m, PersistEntity val, backend ~ PersistEntityBackend val)
+        :: (MonadIO m, PersistRecordBackend val backend)
         => RecursionDirection
         -> EntityField val (Maybe (Key val))
         -> Key val
@@ -67,8 +67,7 @@ class PersistQuery backend => PersistQueryForest backend where
     -- | Get all records in the transitive closure, which match the given
     -- criterion, in the specified order. Returns also the identifiers.
     selectForestSourceRes
-        :: ( PersistEntity val
+        :: ( PersistRecordBackend val backend
-           , PersistEntityBackend val ~ backend
            , MonadIO m1
            , MonadIO m2
            )
@@ -82,8 +81,7 @@ class PersistQuery backend => PersistQueryForest backend where
     -- | Get the 'Key's of all records in the transitive closure, which match
     -- the given criterion.
     selectForestKeysRes
-        :: ( PersistEntity val
+        :: ( PersistRecordBackend val backend
-           , PersistEntityBackend val ~ backend
            , MonadIO m1
            , MonadIO m2
            )
@@ -97,7 +95,7 @@ class PersistQuery backend => PersistQueryForest backend where
     -- | The total number of records in the transitive closure which fulfill
     -- the given criterion.
     countForest
-        :: (MonadIO m, PersistEntity val, backend ~ PersistEntityBackend val)
+        :: (MonadIO m, PersistRecordBackend val backend)
         => RecursionDirection
         -> EntityField val (Maybe (Key val))
         -> Key val
@@ -107,12 +105,12 @@ class PersistQuery backend => PersistQueryForest backend where
 -- | Get all records in the transitive closure, which match the given
 -- criterion, in the specified order. Returns also the identifiers.
 selectForestSource
-    :: ( PersistQueryForest backend
+    :: ( PersistQueryForest (BaseBackend backend)
        , MonadResource m
        , PersistEntity val
-       , PersistEntityBackend val ~ backend
+       , PersistEntityBackend val ~ BaseBackend (BaseBackend backend)
-       , MonadReader env m
+       , MonadReader backend m
-       , HasPersistBackend env backend
+       , HasPersistBackend backend
        )
     => RecursionDirection
     -> EntityField val (Maybe (Key val))
@@ -130,12 +128,12 @@ selectForestSource dir field root filts opts = do
 -- | Get the 'Key's of all records in the transitive closure, which match the
 -- given criterion.
 selectForestKeys
-    :: ( PersistQueryForest backend
+    :: ( PersistQueryForest (BaseBackend backend)
        , MonadResource m
        , PersistEntity val
-       , backend ~ PersistEntityBackend val
+       , BaseBackend (BaseBackend backend) ~ PersistEntityBackend val
-       , MonadReader env m
+       , MonadReader backend m
-       , HasPersistBackend env backend
+       , HasPersistBackend backend
        )
     => RecursionDirection
     -> EntityField val (Maybe (Key val))
@@ -153,8 +151,7 @@ selectForestKeys dir field root filts opts = do
 selectForestList
     :: ( PersistQueryForest backend
        , MonadIO m
-       , PersistEntity val
+       , PersistRecordBackend val backend
-       , PersistEntityBackend val ~ backend
        )
     => RecursionDirection
     -> EntityField val (Maybe (Key val))
@@ -170,8 +167,7 @@ selectForestList dir field root filts opts = do
 selectForestKeysList
     :: ( PersistQueryForest backend
        , MonadIO m
-       , PersistEntity val
+       , PersistRecordBackend val backend
-       , PersistEntityBackend val ~ backend
        )
     => RecursionDirection
     -> EntityField val (Maybe (Key val))

src/Database/Persist/Local/Sql.hs

@@ -224,9 +224,9 @@ sqlUEdge dbname filt tEdge bwd fwd =
 selectGraphNodesList
     :: ( MonadIO m
        , PersistEntityGraphSelect node edge
-       , backend ~ PersistEntityBackend node
+       , BaseBackend backend ~ PersistEntityBackend node
-       , backend ~ PersistEntityBackend edge
+       , BaseBackend backend ~ PersistEntityBackend edge
-       , PersistQuery backend
+       , PersistQueryRead backend
        )
     => PersistEntityGraphSelector node edge
     -> [Filter node]

src/Vervis/Darcs.hs

@@ -60,14 +60,14 @@ import Vervis.SourceTree
 import Vervis.Wiki (WikiView (..))
 
 dirToAnchoredPath :: [EntryName] -> AnchoredPath
-dirToAnchoredPath = AnchoredPath . map (Name . encodeUtf8)
+dirToAnchoredPath = AnchoredPath . map (decodeWhiteName . encodeUtf8)
 
 matchType :: ItemType -> EntryType
 matchType TreeType = TypeTree
 matchType BlobType = TypeBlob
 
 nameToText :: Name -> Text
-nameToText (Name b) = decodeUtf8With strictDecode b
+nameToText = decodeUtf8With strictDecode . encodeWhiteName
 
 itemToEntry :: Name -> TreeItem IO -> DirEntry
 itemToEntry name item = DirEntry (matchType $ itemType item) (nameToText name)
@@ -156,7 +156,7 @@ readWikiView isPage isMain path dir = do
                 else
                     ( init dir
                     , maybe Nothing (Just . Just) . isPage lst
-                    , Just $ Name $ encodeUtf8 lst
+                    , Just $ decodeWhiteName $ encodeUtf8 lst
                     )
                     where
                     lst = last dir

src/Vervis/Foundation.hs

@@ -43,7 +43,7 @@ import Data.Text as T (pack, intercalate, concat)
 --import qualified Data.Text.Encoding as TE
 
 import Text.Jasmine.Local (discardm)
-import Vervis.Import.NoFoundation hiding (Day, last)
+import Vervis.Import.NoFoundation hiding (Handler, Day, last, init)
 import Vervis.Model.Group
 import Vervis.Model.Ident
 import Vervis.Model.Role

src/Vervis/Import.hs

@@ -16,4 +16,4 @@
 module Vervis.Import ( module Import ) where
 
 import Vervis.Foundation            as Import
-import Vervis.Import.NoFoundation   as Import
+import Vervis.Import.NoFoundation   as Import hiding (Handler)

src/Vervis/Model.hs

@@ -86,6 +86,6 @@ instance PersistEntityGraphSelect Ticket TicketDependency where
     selectorField _ = TicketProject
 
 instance PersistEntityGraphNumbered Ticket TicketDependency where
-    numberParam = ticketNumber
+    numberParam _ = ticketNumber
-    numberField = TicketNumber
+    numberField _ = TicketNumber
-    uniqueNode  = UniqueTicket
+    uniqueNode _  = UniqueTicket

src/Vervis/Render.hs

@@ -1,6 +1,6 @@
 {- This file is part of Vervis.
  -
- - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -44,17 +44,20 @@ where
 
 import Prelude
 
+import Control.Monad.Catch (throwM)
 import Control.Monad.Logger (logDebug, logWarn)
 import Data.Foldable (for_)
 import Data.Maybe (fromMaybe)
 import Data.Monoid ((<>))
+import Data.Text (Text)
 --import Formatting hiding (format)
 import Text.Blaze.Html (preEscapedToMarkup)
 import Text.Blaze.Html.Renderer.Text (renderHtml)
 import Text.Highlighter (lexerFromFilename, runLexer, Lexer (lName))
 import Text.Highlighter.Formatters.Html (format)
-import Text.Highlighting.Kate.Styles (tango)
+import Skylighting.Styles (tango)
 import Text.HTML.SanitizeXSS (sanitizeBalance)
+import Text.Pandoc.Class (runPure)
 import Text.Pandoc.Definition (Pandoc)
 import Text.Pandoc.Options
 import Text.Pandoc.Readers.Markdown
@@ -131,102 +134,79 @@ renderCode lexer contentTL contentB =
 readerOptions :: ReaderOptions
 readerOptions = def
     { readerExtensions            = pandocExtensions
-    , readerSmart                 = True
     , readerStandalone            = False
-    , readerParseRaw              = True
     , readerColumns               = 80
     , readerTabStop               = 4
---  , readerOldDashes             = False
---  , readerApplyMacros           = True
 --  , readerIndentedCodeClasses   = []
+--  , readerAbbreviations         = defaultAbbrevs
 --  , readerDefaultImageExtension = ""
-    , readerTrace                 =
-#if DEVELOPMENT
-        True
-#else
-        False
-#endif
 --  , readerTrackChanges          = AcceptChanges
---  , readerFileScope             = False
+--  , readerStripComments         = False
     }
 
 writerOptions :: WriterOptions
 writerOptions = def
-    { writerStandalone       = False
+    {
---  , writerTemplate         = ""
+--    writerTemplate          = Nothing
---  , writerVariables        = []
+--  , writerVariables         = []
-    , writerTabStop          = 4
+      writerTabStop           = 4
-    , writerTableOfContents  = True
+    , writerTableOfContents   = True
---  , writerSlideVariant     = NoSlides
+--  , writerIncremental       = False
---  , writerIncremental      = False
+--  , writerHTMLMathMethod    = PlainMath
---  , writerHTMLMathMethod   = PlainMath
+--  , writerNumberSections    = False
---  , writerIgnoreNotes      = False
+--  , writerNumberOffset      = [0,0,0,0,0,0]
---  , writerNumberSections   = False
+--  , writerSectionDivs       = False
---  , writerNumberOffset     = [0,0,0,0,0,0]
+    , writerExtensions        = pandocExtensions
---  , writerSectionDivs      = False
+--  , writerReferenceLinks    = False
-    , writerExtensions       = pandocExtensions
+--  , writerDpi               = 96
---  , writerReferenceLinks   = False
+    , writerWrapText          = WrapAuto
---  , writerDpi              = 96
+    , writerColumns           = 79
-    , writerWrapText         = WrapAuto
+    , writerEmailObfuscation  = ReferenceObfuscation
-    , writerColumns          = 79
+--  , writerIdentifierPrefix  = ""
-    , writerEmailObfuscation = ReferenceObfuscation
+--  , writerCiteMethod        = Citeproc
---  , writerIdentifierPrefix = ""
+--  , writerHtmlQTags         = False
---  , writerSourceURL        = Nothing
+--  , writerSlideLevel        = Nothing
---  , writerUserDataDir      = Nothing
+--  , writerTopLevelDivision  = TopLevelDefault
---  , writerCiteMethod       = Citeproc
+--  , writerListings          = False
-    , writerHtml5            = True
+    , writerHighlightStyle    = Just tango
---  , writerHtmlQTags        = False
+--  , writerSetextHeaders     = True
---  , writerBeamer           = False
+--  , writerEpubSubdirectory  = "EPUB"
---  , writerSlideLevel       = Nothing
+--  , writerEpubMetadata      = Nothing
---  , writerChapters         = False
+--  , writerEpubFonts         = []
---  , writerListings         = False
+--  , writerEpubChapterLevel  = 1
-    , writerHighlight        = True
+--  , writerTOCDepth          = 3
-    , writerHighlightStyle   = tango
+--  , writerReferenceDoc      = Nothing
---  , writerSetextHeaders    = True
+--  , writerReferenceLocation = EndOfDocument
---  , writerTeXLigatures     = True
+--  , writerSyntaxMap         = defaultSyntaxMap
---  , writerEpubVersion      = Nothing
---  , writerEpubMetadata     = ""
---  , writerEpubStylesheet   = Nothing
---  , writerEpubFonts        = []
---  , writerEpubChapterLevel = 1
---  , writerTOCDepth         = 3
---  , writerReferenceODT     = Nothing
---  , writerReferenceDocx    = Nothing
---  , writerMediaBag         = mempty
-    , writerVerbose          =
-#if DEVELOPMENT
-        True
-#else
-        False
-#endif
---  , writerLaTeXArgs        = []
     }
 
 renderPandoc :: Pandoc -> Widget
-renderPandoc =
+renderPandoc
-    toWidget .
+    = either throwM toWidget
-    preEscapedToMarkup .
+    . fmap
-    sanitizeBalance .
+        ( preEscapedToMarkup
-    TL.toStrict .
+        . sanitizeBalance
-    renderHtml .
+        . TL.toStrict
-    writeHtml writerOptions
+        . renderHtml
+        )
+    . runPure
+    . writeHtml5 writerOptions
 
-renderSourceT :: MediaType -> T.Text -> Widget
+renderSourceT :: MediaType -> Text -> Widget
 renderSourceT mt contentT =
     let contentB = TE.encodeUtf8 contentT
         contentTL = TL.fromStrict contentT
-        contentS = T.unpack contentT
+    in  renderSource mt contentB contentTL contentT
-    in  renderSource mt contentB contentTL contentS
 
 renderSourceBL :: MediaType -> BL.ByteString -> Widget
 renderSourceBL mt contentBL =
     let contentB = BL.toStrict contentBL
         contentTL = TLE.decodeUtf8With TE.lenientDecode contentBL
-        contentS = TL.unpack contentTL
+        contentT = TL.toStrict contentTL
-    in  renderSource mt contentB contentTL contentS
+    in  renderSource mt contentB contentTL contentT
 
-renderSource :: MediaType -> B.ByteString -> TL.Text -> String -> Widget
+renderSource :: MediaType -> B.ByteString -> TL.Text -> Text -> Widget
-renderSource mt contentB contentTL contentS =
+renderSource mt contentB contentTL contentT =
     let mtName = T.pack $ show mt
 
         failed e =
@@ -236,23 +216,15 @@ renderSource mt contentB contentTL contentS =
         plain = renderPlain contentTL
         -- Syntax highlighted source code with line numbers
         code l = renderCode l contentTL contentB
-        -- Rendered document from String source
+        -- Rendered document from Text source
-        docS r =
+        docT r =
-            case r readerOptions contentS of
+            case runPure $ r readerOptions contentT of
                 Left err  -> $logWarn (failed err) >> plain
                 Right doc -> renderPandoc doc
-        -- Rendered document from String source, with warnings
-        docSW r =
-            case r readerOptions contentS of
-                Left err           -> $logWarn (failed err) >> plain
-                Right (doc, warns) -> do
-                    for_ warns $ \ warn ->
-                        $logDebug $ mtName <> " reader warning: " <> T.pack warn
-                    renderPandoc doc
     in  case mt of
             -- * Documents
             PlainText -> plain
-            Markdown  -> docSW readMarkdownWithWarnings
+            Markdown  -> docT readMarkdown
             -- * Programming languages
             -- ** Haskell
             Haskell   -> code L.Haskell.lexer

src/Vervis/Settings.hs

@@ -22,7 +22,7 @@
 -- declared in the Foundation.hs file.
 module Vervis.Settings where
 
-import ClassyPrelude.Conduit
+import ClassyPrelude.Conduit hiding (throw)
 import Yesod hiding (Header, parseTime)
 import Yesod.Static
 import Data.Default (Default (..))

src/Yesod/Auth/Unverified.hs

@@ -188,10 +188,7 @@ maybeVerifiedAuth
     => HandlerT master IO (Maybe (Entity record))
 maybeVerifiedAuth = maybeAuth
 
-redirectToCurrent = const True
+handleAuthLack :: (YesodAuth (HandlerSite m), MonadHandler m) => m a
-
--- handleAuthLack :: (YesodAuth (HandlerSite m), MonadHandler m) => m a
-handleAuthLack :: Yesod master => HandlerT master IO a
 handleAuthLack = do
     aj <- acceptsJson
     if aj

src/Yesod/SessionEntity.hs

@@ -43,9 +43,6 @@
 module Yesod.SessionEntity
     ( maybeKey
     , maybeEntity
-      -- * Remove later when we upgrade to GHC 8
-    , PersistStoreRead
-    , PersistRecordBackend
     )
 where
 
@@ -61,10 +58,6 @@ import Yesod.Core (MonadHandler (..))
 import Yesod.Core.Handler (cached, lookupSession)
 import Yesod.Persist.Core (YesodPersist (..))
 
-type PersistStoreRead = PersistStore
-
-type PersistRecordBackend record backend = (PersistEntity record, PersistEntityBackend record ~ backend)
-
 cachedRecord
     :: ( MonadHandler m
        , HandlerSite m ~ master

stack.yaml

@@ -3,7 +3,7 @@
 
 # Specifies the GHC version and set of packages available (e.g., lts-3.5,
 # nightly-2015-09-21, ghc-7.10.2)
-resolver: lts-6.5
+resolver: lts-10.10
 
 # Local packages, usually specified by relative directory name
 packages:
@@ -25,26 +25,15 @@ packages:
 # Packages to be pulled from upstream that are not in the resolver (e.g.,
 # acme-missiles-0.3)
 extra-deps:
+  - darcs-2.14.0
   - data-default-instances-bytestring-0.0.1
-  - diagrams-svg-1.4.0.2
   - highlighter2-0.2.5
-  - libravatar-0.4
+  - libravatar-0.4.0.2
-  - monad-hash-0.1
+  - monad-hash-0.1.0.2
-    # for 'tuple' package, remove once I use lenses instead
-  - OneTuple-0.2.1
   - persistent-parser-0.1.0.2
   - SimpleAES-0.4.2
-    # for text drawing with 'diagrams'
-  - SVGFonts-1.5.0.1
-  - tagged-0.8.5
   - time-interval-0.1.1
-  - transformers-0.4.3.0
+  - time-units-1.0.0
-  - transformers-compat-0.5.1.4
-    # remove once I use lenses instead
-  - tuple-0.3.0.2
-#  - ssh-0.3.2
-  # Required for M.alter used in hit-graph
-  - unordered-containers-0.2.6.0
 
 # Override default flag values for local packages and extra-deps
 flags:

vervis.cabal

@@ -242,6 +242,7 @@ library
                      , dlist
                      , email-validate
                      , esqueleto
+                     , exceptions
                      , fast-logger
                        -- for building a message tree using DFS in
                        -- Vervis.Discussion, possibly also used by some git
@@ -253,8 +254,6 @@ library
                      , hashable
                        -- for source file highlighting
                      , highlighter2
-                       -- for pandoc inline code highlighting
-                     , highlighting-kate
                      , hit
                      , hit-graph >= 0.1
                      , hit-harder >= 0.1
@@ -288,6 +287,8 @@ library
                      , resourcet
                      , safe
                      , shakespeare
+                       -- for pandoc inline code highlighting
+                     , skylighting
                      , smtp-mail
                      , ssh
                        -- for rendering diagrams