support `INSERT`, `DELETE`, `UPDATE`

10 files changed, 406 insertions, 107 deletions

diff --git a/app/Main.hs b/app/Main.hs
index 8622317..945bfc9 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -49,6 +49,8 @@ serveCmd =
 main :: IO ()
 main = do
   setCurrentDirectory "./data"
+  let root = "."
+      ref = "HEAD"
   A.execParser (A.info (args <**> A.helper) A.idm) >>= \case
     Args {cmd = Repl} -> do
       -- TODO Catch `ParseError` exception
@@ -60,7 +62,12 @@ main = do
       -- @topic repl
       R.evalRepl
         (const . pure $ ">>> ")
-        (liftIO . query' . fromString)
+        ( liftIO
+            . (mapM_ (LB.putStrLn . J.encode) =<<)
+            . Q.withStore root ref
+            . Q.query
+            . fromString
+        )
         ([])
         (Just ':')
         (Just "paste")
@@ -74,11 +81,8 @@ main = do
                 q <-
                   fromString @Q.Query . LB.toString
                     <$> W.lazyRequestBody req
-                r <- Q.query q
+                r <- liftIO $ Q.withStore root ref (Q.query q)
                 respond . W.responseLBS W.status200 [] $
                   J.encode r
             | otherwise ->
                 respond $ W.responseLBS W.status200 [] "OK"
-
-query' :: Q.Query -> IO ()
-query' q = mapM_ (LB.putStrLn . J.encode) =<< Q.query q
diff --git a/astore.cabal b/astore.cabal
index 232b01f..2aa0f73 100644
--- a/astore.cabal
+++ b/astore.cabal
@@ -40,11 +40,14 @@ library
         filepath,
         gitlib,
         gitlib-libgit2,
+        hlibgit2,
         megaparsec,
         mtl,
         parser-combinators,
+        resourcet,
         tagged,
         text,
+        time,
         unliftio,
         unliftio-core,
         unordered-containers,
diff --git a/src/Store.hs b/src/Store.hs
index f7562f5..1cb9392 100644
--- a/src/Store.hs
+++ b/src/Store.hs
@@ -1,6 +1,8 @@
 module Store
   ( module Store.Query,
+    module Store.Store,
   )
 where
 
 import Store.Query
+import Store.Store
diff --git a/src/Store/Exception.hs b/src/Store/Exception.hs
index 245780c..94beaab 100644
--- a/src/Store/Exception.hs
+++ b/src/Store/Exception.hs
@@ -2,10 +2,12 @@ module Store.Exception
   ( DecodeException (DecodeException),
     DuplicateField (DuplicateField),
     ParseError (ParseError),
+    MissingFileName (MissingFileName),
   )
 where
 
 import Control.Exception (Exception)
+import Data.Aeson qualified as J
 
 data DecodeException = DecodeException
   deriving (Show)
@@ -21,3 +23,8 @@ data ParseError = ParseError String
   deriving (Show)
 
 instance Exception ParseError
+
+data MissingFileName = MissingFileName J.Value
+  deriving (Show)
+
+instance Exception MissingFileName
diff --git a/src/Store/Query.hs b/src/Store/Query.hs
index f8575af..ccca93f 100644
--- a/src/Store/Query.hs
+++ b/src/Store/Query.hs
@@ -4,15 +4,18 @@ module Store.Query
   )
 where
 
+import Control.Arrow (second)
 import Control.Exception (throw)
+import Control.Monad.Trans (lift)
 import Data.Aeson qualified as J
 import Data.Aeson.Key qualified as JK
 import Data.Aeson.KeyMap qualified as JM
-import Data.List (foldl', isSuffixOf)
+import Data.List (foldl', foldl1')
 import Data.Map qualified as M
 import Data.Maybe (fromMaybe)
+import Data.Text qualified as T
 import Data.Vector qualified as V
-import Store.Exception (DecodeException (DecodeException))
+import Store.Exception (DecodeException (DecodeException), MissingFileName (MissingFileName))
 import Store.Query.Parser ()
 import Store.Query.Printer ()
 import Store.Query.Record
@@ -20,30 +23,61 @@ import Store.Query.Type
 import Store.Store qualified as S
 import System.FilePath ((</>))
 
-query :: Query -> IO [J.Value]
+query :: Query -> S.StoreM [J.Value]
+query (Delete c w) = do
+  c' <-
+    mapM (\fn -> fmap ((fn,) . fromValue c) . decodeFile $ fn)
+      . map (c </>)
+      =<< S.listFiles c
+  let fps = map fst $ whereBy snd w (map (second (: [])) c')
+  lift $ print fps
+  mapM_ S.deleteFile fps
+  S.commit
+  pure []
+query (Insert vs c) = do
+  let vs' = map (\v -> (fileName v, v)) vs
+
+      fileName v@(J.Object kvs) =
+        case JM.lookup "$fileName" kvs of
+          Just (J.String fileName) -> c </> T.unpack fileName
+          _ -> throw (MissingFileName v)
+  mapM_ (\(fp, v) -> encodeFile fp v) vs'
+  S.commit
+  pure []
 query (Select fs c js es w) = do
   c' <-
-    mapM (fmap (fromValue c) . decodeFile . (c </>)) =<< ls c
+    mapM (fmap (fromValue c) . decodeFile . (c </>))
+      =<< S.listFiles c
   js' <-
     mapM
       ( \(JoinClause t c w) ->
-          fmap (\j' -> JoinClause t (map (fromValue c) j') w) . mapM (decodeFile . (c </>))
-            =<< ls c
+          fmap (\j' -> JoinClause t (map (fromValue c) j') w)
+            . mapM (decodeFile . (c </>))
+            =<< S.listFiles c
       )
       js
   es' <-
     mapM
       ( \(EmbedClause c w) ->
-          fmap (\e' -> EmbedClause (fromValue c e') w) . mapM (decodeFile . (c </>))
-            =<< ls c
+          fmap (\e' -> EmbedClause (fromValue c e') w)
+            . mapM (decodeFile . (c </>))
+            =<< S.listFiles c
       )
       es
   pure $ map (Store.Query.select fs) $ where_ w $ embeds es' $ joins js' c'
-  where
-    ls c =
-      filter (not . (isSuffixOf "/"))
-        <$> S.withStore "." "HEAD" do
-          S.listDirectory c
+query (Update c v w) = do
+  c' <-
+    mapM (\fn -> fmap ((fn,) . fromValue c) . decodeFile $ fn)
+      . map (c </>)
+      =<< S.listFiles c
+  let c'' = whereBy snd w (map (second (: [])) c')
+  mapM_
+    ( \(fp, v') ->
+        encodeFile fp (foldl1' union (map toValue v') `union` v)
+    )
+    c''
+  S.commit
+  pure []
 
 embeds ::
   EmbedClauses (Record [J.Value]) ->
@@ -121,7 +155,10 @@ select (SelectObject kvs) vs =
 select (SelectField f) vs = fromMaybe J.Null (lookups f vs)
 
 where_ :: Maybe WhereClause -> [Records J.Value] -> [Records J.Value]
-where_ w = filter (satisfies w)
+where_ = whereBy id
+
+whereBy :: (a -> [Record J.Value]) -> Maybe WhereClause -> [a] -> [a]
+whereBy f w = filter (satisfies w . f)
 
 satisfies :: Maybe WhereClause -> Records J.Value -> Bool
 satisfies Nothing _ = True
@@ -129,6 +166,10 @@ satisfies (Just (And ws)) vs = all (\w -> satisfies (Just w) vs) ws
 satisfies (Just (Or ws)) vs = any (\w -> satisfies (Just w) vs) ws
 satisfies (Just (Where (Eq f g))) vs = lookups f vs == lookups g vs
 
-decodeFile :: J.FromJSON a => Collection -> IO a
-decodeFile fp = S.withStore "." "HEAD" do
+decodeFile :: J.FromJSON a => Collection -> S.StoreM a
+decodeFile fp =
   fromMaybe (throw DecodeException) . J.decode <$> S.readFile fp
+
+encodeFile :: Collection -> J.Value -> S.StoreM ()
+encodeFile fp v =
+  S.writeFile fp (J.encode v)
diff --git a/src/Store/Query/Parser.hs b/src/Store/Query/Parser.hs
index cb02f32..e16c926 100644
--- a/src/Store/Query/Parser.hs
+++ b/src/Store/Query/Parser.hs
@@ -4,10 +4,14 @@ module Store.Query.Parser () where
 
 import Control.Exception (throw)
 import Control.Monad (void)
+import Data.Aeson qualified as J
+import Data.Aeson.Key qualified as JK
+import Data.Aeson.KeyMap qualified as JM
 import Data.Char (isSpace)
 import Data.Map qualified as M
 import Data.String (IsString (fromString))
 import Data.Text qualified as T
+import Data.Vector qualified as V
 import Data.Void (Void)
 import Store.Exception (ParseError (ParseError))
 import Store.Query.Type
@@ -22,21 +26,53 @@ instance IsString Query where
     where
       parser = do
         void $ P.many P.space1
-        select
-        fs <- fieldSelector
-        from
-        c <- collection
-        js <- joinClauses
-        es <- embedClauses
-        w <- P.optional do
-          where_
-          whereClause
-        P.eof
-        pure $ Select fs c js es w
+        P.choice
+          [ do
+              delete
+              from
+              c <- collection
+              w <- P.optional do
+                where_
+                whereClause
+              pure $ Delete c w,
+            do
+              insert
+              vs <- objects
+              into
+              c <- collection
+              pure $ Insert vs c,
+            do
+              select
+              fs <- fieldSelector
+              from
+              c <- collection
+              js <- joinClauses
+              es <- embedClauses
+              w <- P.optional do
+                where_
+                whereClause
+              pure $ Select fs c js es w,
+            do
+              update
+              c <- collection
+              set
+              v <- object
+              w <-
+                P.optional do
+                  where_
+                  whereClause
+              pure $ Update c v w
+          ]
+          <* P.eof
 
       lexeme :: P.Parsec Void String a -> P.Parsec Void String a
       lexeme = P.lexeme $ void $ P.takeWhileP Nothing isSpace
 
+      set = void $ lexeme (P.string "SET")
+      update = void $ lexeme (P.string "UPDATE")
+      into = void $ lexeme (P.string "INTO")
+      insert = void $ lexeme (P.string "INSERT")
+      delete = void $ lexeme (P.string "DELETE")
       and = void $ lexeme (P.string "AND")
       colon = void $ lexeme (P.string ":")
       comma = void $ lexeme (P.string ",")
@@ -120,6 +156,63 @@ instance IsString Query where
                 SelectField <$> field
             ]
 
+      objects = P.sepBy object comma
+
+      object = lexeme do
+        void $ lexeme $ P.string "{"
+        kvs <-
+          P.sepBy
+            ( do
+                k <-
+                  lexeme $ do
+                    void $ lexeme $ P.string "\""
+                    P.takeWhile1P
+                      Nothing
+                      (/= '\"')
+                      <* (void $ lexeme $ P.string "\"")
+                lexeme $ colon
+                v <- value
+                pure (JK.fromString k, v)
+            )
+            comma
+        void $ lexeme $ P.string "}"
+        pure $ J.Object (JM.fromList kvs)
+
+      value =
+        P.choice
+          [ object,
+            array,
+            string,
+            number,
+            bool,
+            null_
+          ]
+
+      array = lexeme do
+        void $ lexeme $ P.string "["
+        vs <- P.sepBy value comma
+        void $ lexeme $ P.string "]"
+        pure $ J.Array (V.fromList vs)
+
+      string = lexeme do
+        void $ lexeme $ P.string "\""
+        s <- P.takeWhileP Nothing (\c -> c /= '\"')
+        void $ lexeme $ P.string "\""
+        pure $ J.String (T.pack s)
+
+      number = lexeme do
+        J.Number <$> P.scientific
+
+      bool = lexeme do
+        J.Bool
+          <$> P.choice
+            [ const True <$> P.string "true",
+              const False <$> P.string "false"
+            ]
+
+      null_ = lexeme do
+        const J.Null <$> P.string "null"
+
       field :: P.Parsec Void String Field
       field =
         lexeme do
diff --git a/src/Store/Query/Printer.hs b/src/Store/Query/Printer.hs
index 7861bc9..26f4e8b 100644
--- a/src/Store/Query/Printer.hs
+++ b/src/Store/Query/Printer.hs
@@ -2,56 +2,121 @@
 
 module Store.Query.Printer () where
 
+import Data.Aeson qualified as J
+import Data.Aeson.Key qualified as JK
+import Data.Aeson.KeyMap qualified as JM
 import Data.List (intercalate)
 import Data.Maybe (catMaybes, mapMaybe)
+import Data.Text qualified as T
+import Data.Vector qualified as V
 import Store.Query.Field
 import Store.Query.Type
 
 instance Show Query where
+  show (Delete c w) =
+    intercalate " " . catMaybes $
+      [ Just "DELETE FROM ",
+        Just (showCollection c),
+        showWhereClause w
+      ]
+  show (Insert vs c) =
+    intercalate " " . catMaybes $
+      [ Just "INSERT",
+        showValues vs,
+        Just "INTO",
+        Just (showCollection c)
+      ]
   show (Select fs c js es w) =
-    intercalate " " $
-      catMaybes $
-        [ Just "SELECT",
-          Just (showFieldSelector fs),
-          Just "FROM",
-          Just (showCollection c),
-          showJoinClauses js,
-          showEmbedClauses es,
-          showWhereClause w
-        ]
-    where
-      showFieldSelector = error "showFieldSelector"
-      showField = Store.Query.Field.toString
-      showCollection c = c
-      showJoinClauses js = case map showJoinClause js of
-        [] -> Nothing
-        xs -> Just (intercalate " " xs)
-      showJoinClause (JoinClause t c w) =
-        intercalate " " $
-          catMaybes $
-            [ Just (showJoinType t),
-              Just (showCollection c),
-              Just "ON",
-              showWhereClause w
-            ]
-      showJoinType JoinLeft = "LEFT JOIN"
-      showJoinType JoinRight = "RIGHT JOIN"
-      showJoinType JoinFull = "FULL JOIN"
-      showEmbedClauses js = case map showEmbedClause js of
-        [] -> Nothing
-        xs -> Just (intercalate " " xs)
-      showEmbedClause (EmbedClause c w) =
-        intercalate " " $
-          catMaybes $
-            [ Just "EMBED",
-              Just (showCollection c),
-              Just "ON",
-              showWhereClause w
-            ]
-      showWhereClause = showWhereClauseWith id
-      showWhereClause' = showWhereClauseWith (\x -> "(" <> x <> ")")
-      showWhereClauseWith _ Nothing = Nothing
-      showWhereClauseWith wrap (Just (And ws)) = Just (wrap (intercalate "AND" (mapMaybe (showWhereClause' . Just) ws)))
-      showWhereClauseWith wrap (Just (Or ws)) = Just (wrap (intercalate "OR" (mapMaybe (showWhereClause' . Just) ws)))
-      showWhereClauseWith _ (Just (Where p)) = Just (showComparison p)
-      showComparison (Eq a b) = intercalate " " [showField a, "==", showField b]
+    intercalate " " . catMaybes $
+      [ Just "SELECT",
+        Just (showFieldSelector fs),
+        Just "FROM",
+        Just (showCollection c),
+        showJoinClauses js,
+        showEmbedClauses es,
+        showWhereClause w
+      ]
+  show (Update c v w) =
+    intercalate " " . catMaybes $
+      [ Just "UPDATE",
+        Just (showCollection c),
+        Just "SET",
+        Just (showValue v),
+        showWhereClause w
+      ]
+
+showFieldSelector :: FieldSelector -> String
+showFieldSelector = error "showFieldSelector"
+
+showField :: Field -> String
+showField = Store.Query.Field.toString
+
+showCollection :: Collection -> String
+showCollection c = c
+
+showJoinClauses :: [JoinClause String] -> Maybe String
+showJoinClauses js = case map showJoinClause js of
+  [] -> Nothing
+  xs -> Just (intercalate " " xs)
+
+showJoinClause :: JoinClause String -> String
+showJoinClause (JoinClause t c w) =
+  intercalate " " $
+    catMaybes $
+      [ Just (showJoinType t),
+        Just (showCollection c),
+        Just "ON",
+        showWhereClause w
+      ]
+
+showJoinType :: JoinType -> String
+showJoinType JoinLeft = "LEFT JOIN"
+showJoinType JoinRight = "RIGHT JOIN"
+showJoinType JoinFull = "FULL JOIN"
+
+showEmbedClauses :: [EmbedClause String] -> Maybe String
+showEmbedClauses js = case map showEmbedClause js of
+  [] -> Nothing
+  xs -> Just (intercalate " " xs)
+
+showEmbedClause :: EmbedClause String -> String
+showEmbedClause (EmbedClause c w) =
+  intercalate " " $
+    catMaybes $
+      [ Just "EMBED",
+        Just (showCollection c),
+        Just "ON",
+        showWhereClause w
+      ]
+
+showWhereClause :: Maybe WhereClause -> Maybe String
+showWhereClause = showWhereClauseWith id
+
+showWhereClause' :: Maybe WhereClause -> Maybe String
+showWhereClause' = showWhereClauseWith (\x -> "(" <> x <> ")")
+
+showWhereClauseWith :: (String -> String) -> Maybe WhereClause -> Maybe String
+showWhereClauseWith _ Nothing = Nothing
+showWhereClauseWith wrap (Just (And ws)) = Just (wrap (intercalate "AND" (mapMaybe (showWhereClause' . Just) ws)))
+showWhereClauseWith wrap (Just (Or ws)) = Just (wrap (intercalate "OR" (mapMaybe (showWhereClause' . Just) ws)))
+showWhereClauseWith _ (Just (Where p)) = Just (showComparison p)
+
+showComparison :: Comparison -> String
+showComparison (Eq a b) = intercalate " " [showField a, "==", showField b]
+
+showValues :: [J.Value] -> Maybe String
+showValues [] = Nothing
+showValues vs = Just (intercalate ", " (map showValue vs))
+
+showValue :: J.Value -> String
+showValue (J.Object kvs) =
+  intercalate
+    ",\n"
+    (map (\(k, v) -> "\"" <> JK.toString k <> "\" : " <> showValue v) (JM.toList kvs))
+showValue (J.Array (V.toList -> vs)) =
+  "[" <> intercalate ", " (map showValue vs) <> "]"
+showValue (J.String c) = "\"" <> T.unpack c <> "\""
+showValue (J.Number c) = show c
+showValue (J.Bool True) = "true"
+showValue (J.Bool False) = "false"
+showValue J.Null = "null"
diff --git a/src/Store/Query/Record.hs b/src/Store/Query/Record.hs
index b00be27..d663716 100644
--- a/src/Store/Query/Record.hs
+++ b/src/Store/Query/Record.hs
@@ -5,6 +5,7 @@ module Store.Query.Record
     lookup,
     Records,
     lookups,
+    union,
     disjointUnion,
     disjointUnions,
   )
@@ -52,6 +53,11 @@ lookups f rs =
     [v] -> Just v
     (_ : _) -> throw (DuplicateField (toString f))
 
+union :: J.Value -> J.Value -> J.Value
+union (J.Object r) (J.Object s) =
+  J.Object (JM.unionWith union r s)
+union _ s = s
+
 disjointUnion :: J.Value -> J.Value -> J.Value
 disjointUnion (J.Object r) (J.Object s) =
   J.Object (JM.unionWithKey disjointUnion' r s)
diff --git a/src/Store/Query/Type.hs b/src/Store/Query/Type.hs
index abf2c77..7065267 100644
--- a/src/Store/Query/Type.hs
+++ b/src/Store/Query/Type.hs
@@ -14,17 +14,21 @@ module Store.Query.Type
   )
 where
 
+import Data.Aeson qualified as J
 import Data.Map qualified as M
 import Store.Query.Field
 import Store.Query.Record
 
 data Query
-  = Select
+  = Delete Collection (Maybe WhereClause)
+  | Insert [J.Value] Collection
+  | Select
       FieldSelector
       Collection
       (JoinClauses FilePath)
       (EmbedClauses FilePath)
       (Maybe WhereClause)
+  | Update Collection J.Value (Maybe WhereClause)
 
 data FieldSelector
   = SelectObject (M.Map String FieldSelector)
diff --git a/src/Store/Store.hs b/src/Store/Store.hs
index 7917449..511d822 100644
--- a/src/Store/Store.hs
+++ b/src/Store/Store.hs
@@ -1,69 +1,90 @@
 module Store.Store
-  ( withStore,
-    listDirectory,
+  ( StoreM,
+    withStore,
+    listFiles,
     readFile,
+    writeFile,
+    deleteFile,
+    commit,
   )
 where
 
+import Bindings.Libgit2 qualified as B
 import Control.Arrow (first)
 import Control.Exception (Exception, finally)
-import Control.Monad.Catch (MonadCatch, MonadThrow, throwM)
+import Control.Monad (when)
+import Control.Monad.Catch (MonadCatch, MonadMask, 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 Control.Monad.State (MonadState, StateT, evalStateT, get, modify)
+import Control.Monad.Trans (MonadIO, MonadTrans, lift, liftIO)
+import Control.Monad.Trans.Resource (MonadResource, runResourceT)
 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.List (isPrefixOf, isSuffixOf, sort)
+import Data.Tagged (Tagged (Tagged), untag)
 import Data.Text qualified as T
+import Data.Text.Encoding qualified as T
+import Data.Time (getCurrentTimeZone, utcToZonedTime)
+import Data.Time.Clock (getCurrentTime)
+import Foreign
 import Git qualified as G
 import Git.Libgit2 qualified as GB
 import System.FilePath (addTrailingPathSeparator, hasDrive, joinDrive, makeRelative, normalise, splitPath)
-import Prelude hiding (readFile)
+import Text.Printf (printf)
+import Prelude hiding (readFile, writeFile)
 
 newtype StoreT m a = StoreT
-  { runStoreT :: StateT GB.OidPtr (ReaderT GB.LgRepo m) a
+  { runStoreT :: StateT State (ReaderT Env m) a
   }
   deriving
     ( Applicative,
       Functor,
       Monad,
-      MonadReader GB.LgRepo,
-      MonadState GB.OidPtr,
+      MonadReader Env,
+      MonadState State,
       MonadCatch,
       MonadThrow,
-      MonadIO
+      MonadIO,
+      MonadMask,
+      MonadResource
     )
 
-instance MonadTrans StoreT where
-  lift = StoreT . lift . lift
+data Env = Env
+  { repo :: GB.LgRepo,
+    ref :: G.RefName
+  }
 
-class MonadStore m where
-  getCommitOid :: m (G.CommitOid GB.LgRepo)
-  getRepository :: m GB.LgRepo
+data State = State
+  { cid :: G.CommitOid GB.LgRepo,
+    tid :: G.TreeOid GB.LgRepo
+  }
 
-instance Monad m => MonadStore (StoreT m) where
-  getCommitOid = Tagged <$> get
-  getRepository = ask
+instance MonadTrans StoreT where
+  lift = StoreT . lift . lift
 
 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
+  (cid, tid) <- G.runRepository GB.lgFactory repo do
+    Just cid <- fmap Tagged <$> G.resolveReference ref
+    tid <- (.commitTree) <$> G.lookupCommit cid
+    pure (cid, tid)
+  runReaderT
+    (evalStateT (runStoreT action) (State {cid, tid}))
+    (Env {repo, ref})
     `finally` G.runRepository GB.lgFactory repo G.closeRepository
 
 listDirectory :: FilePath -> StoreM [FilePath]
 listDirectory dir' = do
-  cid <- getCommitOid
-  repo <- getRepository
+  State {tid} <- get
+  Env {repo} <- ask
   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
+    tree <- G.lookupTree tid
     sort
       . map (makeRelative dir)
       . filter ((== n + 1) . length . splitPath)
@@ -79,6 +100,10 @@ listDirectory dir' = do
       . map (first (("/" <>) . B.toString))
       <$> G.listTreeEntries tree
 
+listFiles :: FilePath -> StoreM [FilePath]
+listFiles =
+  fmap (filter (not . (isSuffixOf "/"))) . listDirectory
+
 data DoesNotExist = DoesNotExist String FilePath
   deriving (Show)
 
@@ -106,10 +131,10 @@ readFile' ::
   FilePath ->
   StoreM a
 readFile' cat fp = do
-  cid <- getCommitOid
-  repo <- getRepository
+  State {tid} <- get
+  Env {repo} <- ask
   lift $ G.runRepository GB.lgFactory repo do
-    tree <- G.lookupTree =<< (.commitTree) <$> G.lookupCommit cid
+    tree <- G.lookupTree tid
     maybe
       (throwM (DoesNotExist "readFile" fp))
       ( \e ->
@@ -119,3 +144,52 @@ readFile' cat fp = do
             G.TreeEntry _ -> throwM (InappropriateType "readFile" fp)
       )
       =<< G.treeEntry tree (B.fromString fp)
+
+writeFile :: FilePath -> LB.ByteString -> StoreM ()
+writeFile (B.fromString -> fp) v = do
+  State {tid} <- get
+  Env {repo} <- ask
+  tid' <- lift $ G.runRepository GB.lgFactory repo do
+    bid <- G.createBlobUtf8 (T.decodeUtf8 (LB.toStrict v))
+    G.mutateTreeOid tid do
+      G.putBlob fp bid
+  modify $ \s -> s {tid = tid'}
+
+deleteFile :: FilePath -> StoreM ()
+deleteFile (B.fromString -> fp) = do
+  State {tid} <- get
+  Env {repo} <- ask
+  tid' <- lift $ G.runRepository GB.lgFactory repo do
+    G.mutateTreeOid tid do
+      G.dropEntry fp
+      G.currentTreeOid
+  modify $ \s -> s {tid = tid'}
+
+commit :: StoreM ()
+commit = do
+  State {cid, tid} <- get
+  Env {repo, ref} <- ask
+  now <- lift (utcToZonedTime <$> getCurrentTimeZone <*> getCurrentTime)
+  let sig = G.Signature "author" "email" now
+  cid' <-
+    lift $ runResourceT $ G.runRepository GB.lgFactory repo do
+      cid' <-
+        G.commitOid
+          <$> G.createCommit [cid] tid sig sig "auto-commit" (Just ref)
+      when (ref == "HEAD") $ reset cid'
+      pure cid'
+  modify $ \s -> s {cid = cid'}
+
+reset :: MonadIO m => GB.CommitOid -> ReaderT GB.LgRepo m ()
+reset cid = do
+  repo <- GB.getRepository
+  liftIO $ withForeignPtr (GB.repoObj repo) $ \repoPtr -> do
+    withForeignPtr (GB.getOid (untag cid)) $ \oidPtr -> do
+      alloca $ \cidPtr' -> do
+        exitCode <- B.c'git_object_lookup cidPtr' repoPtr oidPtr B.c'GIT_OBJ_COMMIT
+        when (exitCode /= 0) do
+          error (printf "unknown commit %s (%d)" (show cid) (fromIntegral exitCode :: Int))
+        cidPtr <- peek cidPtr'
+        exitCode <- B.c'git_reset repoPtr cidPtr B.c'GIT_RESET_HARD
+        when (exitCode /= 0) do
+          error (printf "reset failed (%d)" (fromIntegral exitCode :: Int))