1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-27 19:04:52 +09:00

Build with LTS 13, GHC 8.6

This commit is contained in:
fr33domlover 2019-05-24 11:49:39 +00:00
parent b64984495f
commit 23e760e373
7 changed files with 24 additions and 29 deletions

View file

@ -62,14 +62,6 @@ newResultShare action = do
tvar <- liftIO $ newTVarIO M.empty
return $ ResultShare tvar action
-- TODO this is copied from stm-2.5, remove when we upgrade LTS
stateTVar :: TVar s -> (s -> (a, s)) -> STM a
stateTVar var f = do
s <- readTVar var
let (a, s') = f s -- since we destructure this, we are strict in f
writeTVar var s'
return a
runShared
:: (MonadIO m, Eq k, Hashable k)
=> ResultShare k v a

View file

@ -34,7 +34,7 @@ import Data.Byteable (toBytes)
import Data.Git
import Data.Git.Harder
import Data.Git.Ref (SHA1)
import Data.Git.Types (GitTime (..))
import Data.Git.Types
import Data.Set (Set)
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8With)
@ -109,7 +109,7 @@ viewPath :: Git SHA1 -> Tree SHA1 -> EntPath -> IO PathView
viewPath git root path = do
let toEnt False = EntObjBlob
toEnt True = EntObjTree
toText = decodeUtf8With lenientDecode . toBytes
toText = decodeUtf8With lenientDecode . getEntNameBytes
adapt (perm, oid, name, isTree) =
(perm, oid, toText name, toEnt isTree)
mkRows t = map adapt <$> viewTree git t

View file

@ -216,8 +216,12 @@ instance Yesod App where
mperson' <- maybeAuthAllowUnverified
for mperson' $ \ (p@(Entity pid person), verified) -> runDB $ do
sharer <- getJust $ personIdent person
[E.Value unread] <- countUnread pid
return (p, verified, sharer, unread :: Int)
unread <- do
vs <- countUnread pid
case vs :: [E.Value Int] of
[E.Value i] -> return i
_ -> error $ "countUnread returned " ++ show vs
return (p, verified, sharer, unread)
(title, bcs) <- breadcrumbs
-- We break up the default layout into two components:

View file

@ -28,7 +28,7 @@ import Control.Arrow ((***))
import Control.Monad (join)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except
import Data.Algorithm.Patience (diff, Item (..))
import Patience (diff, Item (..))
import Data.Byteable (toBytes)
import Data.Foldable (foldlM, find)
import Data.Git.Diff
@ -38,7 +38,7 @@ import Data.Git.Monad
import Data.Git.Ref (SHA1, fromHex, toHex)
import Data.Git.Storage (getObject_)
import Data.Git.Storage.Object (Object (..))
import Data.Git.Types (GitTime (..), ModePerm (..), EntPath, Blob (..))
import Data.Git.Types hiding (ObjectType (..))
import Data.Graph.Inductive.Graph (noNodes)
import Data.Graph.Inductive.Query.Topsort
import Data.List.NonEmpty (NonEmpty ((:|)))
@ -217,7 +217,7 @@ patch edits c = Patch
(title, desc) = split $ decodeUtf8 $ commitMessage c
ep2fp :: EntPath -> FilePath
ep2fp = T.unpack . decodeUtf8 . B.intercalate "/" . map toBytes
ep2fp = T.unpack . decodeUtf8 . B.intercalate "/" . map getEntNameBytes
unModePerm :: ModePerm -> Word32
unModePerm (ModePerm w) = w

View file

@ -24,6 +24,7 @@ import Prelude
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Binary.Put
import Data.Maybe
import Data.Git.Harder (ObjId (..))
import Data.Git.Harder.Pack
import Data.Git.Repository (getCommit)
@ -74,8 +75,9 @@ getGitRefDiscoverR shr rp = do
)
{ std_out = CreatePipe
}
(_, Just h, _, _) <-
(_, mh, _, _) <-
liftIO $ createProcess settings
let h = fromJust mh
refs <- liftIO $ B.hGetContents h
let content = runPut $ do
putService UploadPack
@ -128,7 +130,9 @@ postGitUploadRequestR shr rp = do
{ std_in = CreatePipe
, std_out = CreatePipe
}
(Just hin, Just hout, _, _) <- liftIO $ createProcess settings
(mhin, mhout, _, _) <- liftIO $ createProcess settings
let hin = fromJust mhin
hout = fromJust mhout
liftIO $ BL.hPut hin body >> hClose hin
setHeader "Cache-Control" "no-cache"
let loop = do

View file

@ -91,14 +91,6 @@ class Yesod site => YesodRemoteActorStore site where
siteActorFetchShare :: site -> ActorFetchShare site
-- TODO this is copied from stm-2.5, remove when we upgrade LTS
stateTVar :: TVar s -> (s -> (a, s)) -> STM a
stateTVar var f = do
s <- readTVar var
let (a, s') = f s -- since we destructure this, we are strict in f
writeTVar var s'
return a
withHostLock
:: ( MonadHandler m
, MonadUnliftIO m

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-12.20
resolver: lts-13.22
# Local packages, usually specified by relative directory name
packages:
@ -29,17 +29,20 @@ extra-deps:
- ./lib/yesod-http-signature
- ./lib/yesod-mail-send
- DRBG-0.5.5
- SimpleAES-0.4.2
- darcs-2.14.2
- data-default-instances-bytestring-0.0.1
- esqueleto-2.7.0
- git-0.2.2
- git-0.3.0
- graphviz-2999.20.0.3
- highlighter2-0.2.5
- libravatar-0.4.0.2
- megaparsec-7.0.5
- monad-hash-0.1.0.2
- monadcryptorandom-0.7.2.1
- patience-0.1.1
- patience-0.2.1.1
- pwstore-fast-2.4.4
- sandi-0.5
- time-interval-0.1.1
- time-units-1.0.0
- url-2.1.3