Commit 74abc740f4b15693885e230b3fe059f55333edb8 Parent: ca39007d14ffa3f3b0a653382ed0c3e9d35ff101 Author: mcol <mcol@posteo.net> Date: 2021-09-21 23:13:41 +0100 Committer: mcol <mcol@posteo.net> Committed: 2021-09-21 23:13:41 +0100 Add first conduit pieces
src/Repositories.hs Modified
@@ -4,7 +4,9 @@ run ) where +import Conduit (runConduit, (.|), sinkList) import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Reader (ReaderT) import Data.Foldable (foldMap) import Data.Tagged import Data.Text (unpack, Text) @@ -36,15 +38,23 @@ (after informing the user of course). -} processRepo :: [Template] -> FilePath -> FilePath -> IO () -processRepo templates outputDirectory path = withRepository lgFactory path $ do +processRepo templates outputDirectory path = withRepository lgFactory path $ + processRepo' templates outputDirectory path + +-- This is split out to make type reasoning a bit easier. +processRepo' :: [Template] -> FilePath -> FilePath -> ReaderT LgRepo IO () +processRepo' templates outputDirectory path = do liftIO $ createDirectoryIfMissing True outPath ref <- resolveReference "HEAD" case ref of Nothing -> liftIO . print $ "gitserve: " <> name <> ": Failed to resolve HEAD." Just commitID -> do description <- liftIO $ getDescription $ outPath </> "description" - head <- lookupCommit (Tagged commitID) - nodes <- lookupTree (commitTree head) >>= listTreeEntries + headc <- lookupCommit $ Tagged commitID + obj <- runConduit $ sourceObjects Nothing (Tagged commitID) False .| sinkList + --a <- loadObject . head $ obj + --liftIO . print . loadObject <$> obj + nodes <- lookupTree (commitTree headc) >>= listTreeEntries return () where name = takeFileName path
gitserve.cabal Modified
@@ -19,6 +19,7 @@ other-modules: Config, Repositories, Templates default-language: Haskell2010 build-depends: base >= 4.7 && < 5 + , conduit , dhall , directory , filepath @@ -27,3 +28,4 @@ , gitlib-libgit2 , tagged , text + , transformers