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:
parent
b64984495f
commit
23e760e373
7 changed files with 24 additions and 29 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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:
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
11
stack.yaml
11
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-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
|
||||
|
|
Loading…
Reference in a new issue