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)