From 950eea3ba04e94cf3d5797f9b5d32b2621c89b55 Mon Sep 17 00:00:00 2001
From: Alexander Foremny <aforemny@posteo.de>
Date: Tue, 13 Feb 2024 02:07:20 +0100
Subject: refactor library

---
 app/Store.hs | 121 -----------------------------------------------------------
 1 file changed, 121 deletions(-)
 delete mode 100644 app/Store.hs

(limited to 'app/Store.hs')

diff --git a/app/Store.hs b/app/Store.hs
deleted file mode 100644
index 3a899b6..0000000
--- a/app/Store.hs
+++ /dev/null
@@ -1,121 +0,0 @@
-module Store
-  ( withStore,
-    listDirectory,
-    readFile,
-  )
-where
-
-import Control.Arrow (first)
-import Control.Exception (Exception, finally)
-import Control.Monad.Catch (MonadCatch, MonadThrow, throwM)
-import Control.Monad.Reader (MonadReader, ReaderT, ask, runReaderT)
-import Control.Monad.State (MonadState, StateT, evalStateT, get)
-import Control.Monad.Trans (MonadIO, MonadTrans, lift)
-import Data.ByteString qualified as B
-import Data.ByteString.Lazy qualified as LB
-import Data.ByteString.UTF8 qualified as B
-import Data.List (isPrefixOf, sort)
-import Data.Tagged (Tagged (Tagged))
-import Data.Text qualified as T
-import Git qualified as G
-import Git.Libgit2 qualified as GB
-import System.FilePath (addTrailingPathSeparator, hasDrive, joinDrive, makeRelative, normalise, splitPath)
-import Prelude hiding (readFile)
-
-newtype StoreT m a = StoreT
-  { runStoreT :: StateT GB.OidPtr (ReaderT GB.LgRepo m) a
-  }
-  deriving
-    ( Applicative,
-      Functor,
-      Monad,
-      MonadReader GB.LgRepo,
-      MonadState GB.OidPtr,
-      MonadCatch,
-      MonadThrow,
-      MonadIO
-    )
-
-instance MonadTrans StoreT where
-  lift = StoreT . lift . lift
-
-class MonadStore m where
-  getCommitOid :: m (G.CommitOid GB.LgRepo)
-  getRepository :: m GB.LgRepo
-
-instance Monad m => MonadStore (StoreT m) where
-  getCommitOid = Tagged <$> get
-  getRepository = ask
-
-type StoreM = StoreT IO
-
-withStore :: FilePath -> G.RefName -> StoreM a -> IO a
-withStore repoPath ref action = do
-  repo <- G.openRepository GB.lgFactory G.defaultRepositoryOptions {G.repoPath}
-  Just cid <- G.runRepository GB.lgFactory repo (G.resolveReference ref)
-  runReaderT (evalStateT (runStoreT action) cid) repo
-    `finally` G.runRepository GB.lgFactory repo G.closeRepository
-
-listDirectory :: FilePath -> StoreM [FilePath]
-listDirectory dir' = do
-  cid <- getCommitOid
-  repo <- getRepository
-  lift $ G.runRepository GB.lgFactory repo $ do
-    let dir = normalise $ if hasDrive dir' then dir' else joinDrive "/" dir'
-        n = length (splitPath dir)
-    tree <- G.lookupTree =<< (.commitTree) <$> G.lookupCommit cid
-    sort
-      . map (makeRelative dir)
-      . filter ((== n + 1) . length . splitPath)
-      . filter (isPrefixOf (addTrailingPathSeparator dir))
-      . map fst
-      . map
-        ( \e ->
-            case snd e of
-              G.BlobEntry _ _ -> e
-              G.CommitEntry _ -> error "XXX commit entry"
-              G.TreeEntry _ -> first addTrailingPathSeparator e
-        )
-      . map (first (("/" <>) . B.toString))
-      <$> G.listTreeEntries tree
-
-data DoesNotExist = DoesNotExist String FilePath
-  deriving (Show)
-
-instance Exception DoesNotExist
-
-data InappropriateType = InappropriateType String FilePath
-  deriving (Show)
-
-instance Exception InappropriateType
-
-class Readable a where
-  readFile :: FilePath -> StoreM a
-
-instance Readable T.Text where
-  readFile = readFile' G.catBlobUtf8
-
-instance Readable B.ByteString where
-  readFile = readFile' G.catBlob
-
-instance Readable LB.ByteString where
-  readFile = readFile' G.catBlobLazy
-
-readFile' ::
-  (G.BlobOid GB.LgRepo -> ReaderT GB.LgRepo IO a) ->
-  FilePath ->
-  StoreM a
-readFile' cat fp = do
-  cid <- getCommitOid
-  repo <- getRepository
-  lift $ G.runRepository GB.lgFactory repo do
-    tree <- G.lookupTree =<< (.commitTree) <$> G.lookupCommit cid
-    maybe
-      (throwM (DoesNotExist "readFile" fp))
-      ( \e ->
-          case e of
-            G.BlobEntry bid _ -> cat bid
-            G.CommitEntry _ -> error "XXX commit entry"
-            G.TreeEntry _ -> throwM (InappropriateType "readFile" fp)
-      )
-      =<< G.treeEntry tree (B.fromString fp)
-- 
cgit v1.2.3