diff --git a/src/Control/Concurrent/ResultShare.hs b/src/Control/Concurrent/ResultShare.hs index 5998aec..ed83da8 100644 --- a/src/Control/Concurrent/ResultShare.hs +++ b/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 diff --git a/src/Data/Git/Local.hs b/src/Data/Git/Local.hs index e2b2f31..b648c35 100644 --- a/src/Data/Git/Local.hs +++ b/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 diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index 6b7ab45..4595a3b 100644 --- a/src/Vervis/Foundation.hs +++ b/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 - 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: diff --git a/src/Vervis/Git.hs b/src/Vervis/Git.hs index 0cb5f14..1d34488 100644 --- a/src/Vervis/Git.hs +++ b/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 diff --git a/src/Vervis/Handler/Git.hs b/src/Vervis/Handler/Git.hs index a2f021c..61c59aa 100644 --- a/src/Vervis/Handler/Git.hs +++ b/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 diff --git a/src/Vervis/RemoteActorStore.hs b/src/Vervis/RemoteActorStore.hs index ed409a0..09e020b 100644 --- a/src/Vervis/RemoteActorStore.hs +++ b/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 diff --git a/stack.yaml b/stack.yaml index e4b4f81..7cbe8a7 100644 --- a/stack.yaml +++ b/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