🐙 Templated web page generator for your git repositories
git clone https://github.com/m-col/gitja
Files | Refs | Readme | License

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