implement writeMetadataDiff_

Author: lehmacdj

cli/graph.cabal

@@ -116,6 +116,7 @@ default-extensions:
 - RecordWildCards
 - ScopedTypeVariables
 - StandaloneDeriving
+- StandaloneKindSignatures
 - StrictData
 - TupleSections
 - TypeApplications

cli/package.yaml

@@ -7,11 +7,15 @@ import Effect.RawGraph
 metadataFile :: FilePath -> NID -> FilePath
 metadataFile base nid = base </> (show nid ++ ".json")
 
-nodeDataFile :: FilePath -> NID -> FilePath
-nodeDataFile base nid = base </> (show nid ++ ".data")
+legacyNodeDataFile :: FilePath -> NID -> FilePath
+legacyNodeDataFile base nid = nodeDataFile base nid ".data"
+
+nodeDataFile :: FilePath -> NID -> String -> FilePath
+nodeDataFile base nid extension = base </> (show nid ++ extension)
 
 getMetadataFile :: Member RawGraph effs => NID -> Sem effs FilePath
 getMetadataFile nid = metadataFile <$> getGraphFilePath <*> pure nid
 
-getNodeDataFile :: Member RawGraph effs => NID -> Sem effs FilePath
-getNodeDataFile nid = nodeDataFile <$> getGraphFilePath <*> pure nid
+getNodeDataFile :: Member RawGraph effs => NID -> String -> Sem effs FilePath
+getNodeDataFile nid extension =
+  nodeDataFile <$> getGraphFilePath <*> pure nid <*> pure extension

cli/src/DAL/DirectoryFormat.hs

@@ -0,0 +1,65 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module DAL.FileSystemOperations.Data where
+
+import DAL.DirectoryFormat
+import Effect.RawGraph
+import Error.Missing
+import Error.UserError
+import Models.NID
+import MyPrelude
+import System.Directory (removeFile)
+import System.MacOS.NSFileCoordinator
+
+data GraphDataFilesystemOperations m a where
+  ReadNodeData :: NID -> String -> GraphDataFilesystemOperations m (Maybe ByteString)
+  WriteNodeData :: NID -> String -> ByteString -> GraphDataFilesystemOperations m ()
+  DeleteNodeData :: NID -> String -> GraphDataFilesystemOperations m ()
+
+makeSem ''GraphDataFilesystemOperations
+
+readNodeData_ ::
+  Members [RawGraph, Embed IO, Error UserError] effs =>
+  NID ->
+  -- | File extension for the node's data
+  String ->
+  Sem effs (Maybe ByteString)
+readNodeData_ nid fileExtension = do
+  path <- getNodeDataFile nid fileExtension
+  result <- embed $
+    coordinateReading path False defaultReadingOptions $ \path' ->
+      try @IO @IOError $ readFile path'
+  pure $ either (const Nothing) Just result
+
+writeNodeData_ ::
+  Members [RawGraph, Embed IO, Error UserError] effs =>
+  NID ->
+  -- | File extension for the node's data
+  String ->
+  ByteString ->
+  Sem effs ()
+writeNodeData_ nid extension rawData = do
+  path <- getNodeDataFile nid extension
+  embedCatchingErrors $
+    coordinateWriting path False defaultWritingOptions $ \path' ->
+      writeFile path' rawData
+
+deleteNodeData_ ::
+  Members [RawGraph, Embed IO, Error UserError] effs =>
+  NID ->
+  -- | File extension for the node's data
+  String ->
+  Sem effs ()
+deleteNodeData_ nid extension = do
+  path <- getNodeDataFile nid extension
+  embedCatchingErrors $
+    coordinateWriting path False defaultWritingOptions removeFile
+
+runGraphDataFilesystemOperationsIO ::
+  Members [RawGraph, Embed IO, Error UserError] r =>
+  Sem (GraphDataFilesystemOperations : r) a ->
+  Sem r a
+runGraphDataFilesystemOperationsIO = interpret \case
+  ReadNodeData nid extension -> readNodeData_ nid extension
+  WriteNodeData nid extension rawData -> writeNodeData_ nid extension rawData
+  DeleteNodeData nid extension -> deleteNodeData_ nid extension

cli/src/DAL/FileSystemOperations.hs

@@ -0,0 +1,60 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module DAL.FileSystemOperations.Metadata where
+
+import DAL.DTO
+import DAL.JSON
+import DAL.DirectoryFormat
+import Effect.RawGraph
+import Error.Missing
+import Error.UserError
+import Models.NID
+import Models.Node
+import MyPrelude
+import System.MacOS.NSFileCoordinator
+import System.Directory (removeFile)
+
+data GraphMetadataFilesystemOperations m a where
+  ReadNodeMetadata :: NID -> GraphMetadataFilesystemOperations m (Maybe (Node Text ()))
+  WriteNodeMetadata :: Node Text () -> GraphMetadataFilesystemOperations m ()
+  DeleteNodeMetadata :: NID -> GraphMetadataFilesystemOperations m ()
+
+makeSem ''GraphMetadataFilesystemOperations
+
+readNodeMetadata_ ::
+  Members [Embed IO, Error UserError] effs =>
+  FilePath -> Sem effs (Maybe (Node Text ()))
+readNodeMetadata_ path = withEarlyReturn do
+  result <- embedCatchingErrors $ coordinateReading path False defaultReadingOptions $ \path' ->
+    try @IO @IOError $ readFile path'
+  serialized <- either (const $ returnEarly Nothing) pure result
+  dto <- decodeJSON serialized
+  pure $ Just (nodeFromDTO dto)
+
+writeNodeMetadata_ ::
+  Members [Embed IO, Error UserError] effs =>
+  FilePath ->
+  Node Text () ->
+  Sem effs ()
+writeNodeMetadata_ path node  = do
+  let dto = nodeToDTO node
+  let serialized = toStrict $ encodeJSON dto
+  embedCatchingErrors $ coordinateWriting path False defaultWritingOptions $ \path' ->
+    writeFile path' serialized
+
+deleteNodeMetadata_ ::
+  Members [RawGraph, Embed IO, Error UserError] effs =>
+  FilePath ->
+  Sem effs ()
+deleteNodeMetadata_ path = do
+  embedCatchingErrors $ coordinateWriting path False defaultWritingOptions $ \path' ->
+    removeFile path'
+
+runGraphMetadataFilesystemOperations ::
+  Members [RawGraph, Embed IO, Error UserError] r =>
+  Sem (GraphMetadataFilesystemOperations : r) a ->
+  Sem r a
+runGraphMetadataFilesystemOperations = interpret \case
+  ReadNodeMetadata nid -> readNodeMetadata_ =<< getMetadataFile nid
+  WriteNodeMetadata node -> (`writeNodeMetadata_` node) =<< getMetadataFile node.nid
+  DeleteNodeMetadata nid -> deleteNodeMetadata_ =<< getMetadataFile nid