forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Upgrade to GHC 8 and LTS 10.10

Browse source
This commit is contained in:
fr33domlover 2018-05-16 00:02:54 +00:00
parent 47b0cdfc2f
commit 8eca3fa647
15 changed files with 101 additions and 162 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
INSTALL.md
View file

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

11
src/Data/ByteString/Local.hs
View file

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

6
src/Database/Persist/Local/Class/PersistEntityGraph.hs
View file

@ -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
numberField :: EntityField n Int
uniqueNode :: PersistEntityGraphSelector n e -> Int -> Unique n
numberParam :: Proxy (n, e) -> n -> Int
numberField :: Proxy (n, e) -> EntityField n Int
uniqueNode :: Proxy (n, e) -> PersistEntityGraphSelector n e -> Int -> Unique n

34
src/Database/Persist/Local/Class/PersistQueryForest.hs
View file

@ -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
, PersistEntityBackend val ~ backend
:: ( PersistRecordBackend 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
, PersistEntityBackend val ~ backend
:: ( PersistRecordBackend 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
, MonadReader env m
, HasPersistBackend env backend
, PersistEntityBackend val ~ BaseBackend (BaseBackend backend)
, MonadReader backend m
, 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
, MonadReader env m
, HasPersistBackend env backend
, BaseBackend (BaseBackend backend) ~ PersistEntityBackend val
, MonadReader backend m
, 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
, PersistEntityBackend val ~ backend
, PersistRecordBackend 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
, PersistEntityBackend val ~ backend
, PersistRecordBackend val backend
)
=> RecursionDirection
-> EntityField val (Maybe (Key val))

6
src/Database/Persist/Local/Sql.hs
View file

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

6
src/Vervis/Darcs.hs
View file

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

2
src/Vervis/Foundation.hs
View file

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

2
src/Vervis/Import.hs
View file

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

6
src/Vervis/Model.hs
View file

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

102
src/Vervis/Render.hs
View file

@ -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,36 +134,25 @@ 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 = []
, writerTabStop = 4
writerTabStop = 4
, writerTableOfContents = True
-- , writerSlideVariant = NoSlides
-- , writerIncremental = False
-- , writerHTMLMathMethod = PlainMath
-- , writerIgnoreNotes = False
-- , writerNumberSections = False
-- , writerNumberOffset = [0,0,0,0,0,0]
-- , writerSectionDivs = False
@ -171,62 +163,50 @@ writerOptions = def
, writerColumns = 79
, writerEmailObfuscation = ReferenceObfuscation
-- , writerIdentifierPrefix = ""
-- , writerSourceURL = Nothing
-- , writerUserDataDir = Nothing
-- , writerCiteMethod = Citeproc
, writerHtml5 = True
-- , writerHtmlQTags = False
-- , writerBeamer = False
-- , writerSlideLevel = Nothing
-- , writerChapters = False
-- , writerTopLevelDivision = TopLevelDefault
-- , writerListings = False
, writerHighlight = True
, writerHighlightStyle = tango
, writerHighlightStyle = Just tango
-- , writerSetextHeaders = True
-- , writerTeXLigatures = True
-- , writerEpubVersion = Nothing
-- , writerEpubMetadata = ""
-- , writerEpubStylesheet = Nothing
-- , writerEpubSubdirectory = "EPUB"
-- , writerEpubMetadata = Nothing
-- , writerEpubFonts = []
-- , writerEpubChapterLevel = 1
-- , writerTOCDepth = 3
-- , writerReferenceODT = Nothing
-- , writerReferenceDocx = Nothing
-- , writerMediaBag = mempty
, writerVerbose =
#if DEVELOPMENT
True
#else
False
#endif
-- , writerLaTeXArgs = []
-- , writerReferenceDoc = Nothing
-- , writerReferenceLocation = EndOfDocument
-- , writerSyntaxMap = defaultSyntaxMap
}
renderPandoc :: Pandoc -> Widget
renderPandoc =
toWidget .
preEscapedToMarkup .
sanitizeBalance .
TL.toStrict .
renderHtml .
writeHtml writerOptions
renderPandoc
= either throwM toWidget
. fmap
( preEscapedToMarkup
. sanitizeBalance
. TL.toStrict
. 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 contentS
in renderSource mt contentB contentTL contentT
renderSourceBL :: MediaType -> BL.ByteString -> Widget
renderSourceBL mt contentBL =
let contentB = BL.toStrict contentBL
contentTL = TLE.decodeUtf8With TE.lenientDecode contentBL
contentS = TL.unpack contentTL
in renderSource mt contentB contentTL contentS
contentT = TL.toStrict contentTL
in renderSource mt contentB contentTL contentT
renderSource :: MediaType -> B.ByteString -> TL.Text -> String -> Widget
renderSource mt contentB contentTL contentS =
renderSource :: MediaType -> B.ByteString -> TL.Text -> Text -> Widget
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
docS r =
case r readerOptions contentS of
-- Rendered document from Text source
docT r =
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

2
src/Vervis/Settings.hs
View file

@ -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 (..))

5
src/Yesod/Auth/Unverified.hs
View file

@ -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 :: Yesod master => HandlerT master IO a
handleAuthLack :: (YesodAuth (HandlerSite m), MonadHandler m) => m a
handleAuthLack = do
aj <- acceptsJson
if aj

7
src/Yesod/SessionEntity.hs
View file

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

21
stack.yaml
View file

@ -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
- monad-hash-0.1
# for 'tuple' package, remove once I use lenses instead
- OneTuple-0.2.1
- libravatar-0.4.0.2
- monad-hash-0.1.0.2
- 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
- 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
- time-units-1.0.0
# Override default flag values for local packages and extra-deps
flags:

5
vervis.cabal
View file

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