Build with LTS 13, GHC 8.6

src/Control/Concurrent/ResultShare.hs

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

src/Data/Git/Local.hs

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

src/Vervis/Foundation.hs

@@ -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
+                unread <- do
-                return (p, verified, sharer, unread :: Int)
+                    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:

src/Vervis/Git.hs

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

src/Vervis/Handler/Git.hs

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

src/Vervis/RemoteActorStore.hs

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

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