Move IO like effects into IOWrapper submodule

lehmacdj · lehmacdj · commit 2c837dbc6c86 · 2025-02-16T21:44:07.000-05:00
diff --git a/cli/graph.cabal b/cli/graph.cabal
diff --git a/cli/src/DAL/DirectoryFormat.hs b/cli/src/DAL/DirectoryFormat.hs
@@ -2,7 +2,7 @@ module DAL.DirectoryFormat where
 
 import MyPrelude
 import Models.NID
-import Effect.RawGraph
+import DAL.RawGraph
 
 metadataFile :: FilePath -> NID -> FilePath
 metadataFile base nid = base </> (show nid ++ ".json")
diff --git a/cli/src/DAL/FileSystemOperations/Data.hs b/cli/src/DAL/FileSystemOperations/Data.hs
@@ -3,7 +3,7 @@
 module DAL.FileSystemOperations.Data where
 
 import DAL.DirectoryFormat
-import Effect.RawGraph
+import DAL.RawGraph
 import Error.Missing
 import Error.UserError
 import Models.NID
diff --git a/cli/src/DAL/FileSystemOperations/Metadata.hs b/cli/src/DAL/FileSystemOperations/Metadata.hs
@@ -5,7 +5,7 @@ module DAL.FileSystemOperations.Metadata where
 import DAL.DTO
 import DAL.JSON
 import DAL.DirectoryFormat
-import Effect.RawGraph
+import DAL.RawGraph
 import Error.Missing
 import Error.UserError
 import Models.NID
diff --git a/cli/src/DAL/FileSystemOperations/MetadataWriteDiff.hs b/cli/src/DAL/FileSystemOperations/MetadataWriteDiff.hs
@@ -5,7 +5,7 @@ module DAL.FileSystemOperations.MetadataWriteDiff where
 import DAL.DTO
 import DAL.DirectoryFormat
 import DAL.JSON
-import Effect.RawGraph
+import DAL.RawGraph
 import Error.Missing
 import Error.UserError
 import Models.Edge
diff --git a/cli/src/DAL/Interpreters.hs b/cli/src/DAL/Interpreters.hs
@@ -1,7 +1,7 @@
 module DAL.Interpreters where
 
 import qualified Control.Exception as E
-import Effect.RawGraph
+import DAL.RawGraph
 import Error.UserError
 import MyPrelude
 import Polysemy.Error
diff --git a/cli/src/DAL/RawGraph.hs b/cli/src/DAL/RawGraph.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE TemplateHaskell #-}
 
-module Effect.RawGraph where
+module DAL.RawGraph where
 
 import MyPrelude
 import Polysemy.Input
diff --git a/cli/src/Effect/Console.hs b/cli/src/Effect/Console.hs
diff --git a/cli/src/Effect/IOWrapper/DisplayImage.hs b/cli/src/Effect/IOWrapper/DisplayImage.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Effect.IOWrapper.DisplayImage where
+
+import MyPrelude
+import System.IO.Term.Image
+
+data DisplayImage m a where
+  -- | print a LBS as an image
+  DisplayImage :: LByteString -> DisplayImage m ()
+
+makeSem ''DisplayImage
+
+interpretDisplayImageIO ::
+  (Member (Embed IO) effs) =>
+  Sem (DisplayImage : effs) a ->
+  Sem effs a
+interpretDisplayImageIO = interpret $ \case
+  DisplayImage i -> liftIO $ printImage i
diff --git a/cli/src/Effect/IOWrapper/Editor.hs b/cli/src/Effect/IOWrapper/Editor.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE TemplateHaskell #-}
 
-module Effect.Editor where
+module Effect.IOWrapper.Editor where
 
 import DAL.Serialization
 import Models.NID (NID)
diff --git a/cli/src/Effect/IOWrapper/FileSystem.hs b/cli/src/Effect/IOWrapper/FileSystem.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE TemplateHaskell #-}
 
-module Effect.FileSystem where
+module Effect.IOWrapper.FileSystem where
 
 import Error.UserError
 import MyPrelude
diff --git a/cli/src/Effect/IOWrapper/FileTypeOracle.hs b/cli/src/Effect/IOWrapper/FileTypeOracle.hs
@@ -3,7 +3,7 @@
 -- |
 -- Effect for testing the filetype of a data file. Underlyingly uses file(1)
 -- shell command.
-module Effect.FileTypeOracle
+module Effect.IOWrapper.FileTypeOracle
   ( runFileTypeOracle,
     getExtension,
     FileTypeOracle (..),
diff --git a/cli/src/Effect/IOWrapper/GetTime.hs b/cli/src/Effect/IOWrapper/GetTime.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE TemplateHaskell #-}
 
-module Effect.Time where
+module Effect.IOWrapper.GetTime where
 
 import Data.Time.Clock.POSIX
 import MyPrelude
diff --git a/cli/src/Effect/IOWrapper/Web.hs b/cli/src/Effect/IOWrapper/Web.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE TemplateHaskell #-}
 
-module Effect.Web where
+module Effect.IOWrapper.Web where
 
 import Error.UserError
 import MyPrelude
diff --git a/cli/src/Effect/Interpreters.hs b/cli/src/Effect/Interpreters.hs
@@ -4,17 +4,17 @@ module Effect.Interpreters where
 
 import Control.Arrow ((>>>))
 import Control.Lens
-import Effect.Console
-import Effect.Editor
-import Effect.FileSystem
-import Effect.FileTypeOracle
+import Effect.IOWrapper.DisplayImage
+import Effect.IOWrapper.Editor
+import Effect.IOWrapper.FileSystem
+import Effect.IOWrapper.FileTypeOracle
 import Effect.FreshNID
 import Effect.NodeLocated
-import Effect.Time
+import Effect.IOWrapper.GetTime
 import Error.UserError
 import Effect.Util
 import Effect.Warn
-import Effect.Web
+import Effect.IOWrapper.Web
 import Graph.Effect
 import Models.History
 import Models.NID
@@ -28,7 +28,10 @@ import Polysemy.State
 import System.Console.Haskeline (InputT)
 import qualified System.Console.Haskeline as H
 import System.Random
-import Effect.RawGraph
+import DAL.RawGraph
+import DAL.FileSystemOperations.Metadata
+import DAL.FileSystemOperations.MetadataWriteDiff
+import DAL.FileSystemOperations.Data
 
 data Env = Env
   { filePath :: IORef FilePath,
@@ -79,7 +82,7 @@ printingErrorsAndWarnings = printWarnings >>> printErrors
 
 type HasMainEffects effs =
   ( Members
-      [ Console,
+      [ DisplayImage,
         Error UserError,
         SetLocation,
         GetLocation,
@@ -100,6 +103,35 @@ type HasMainEffects effs =
     HasGraph String effs
   )
 
+type family Concat (a :: [k]) (b :: [k]) :: [k] where
+  Concat '[] b = b
+  Concat (a ': as) b = a ': Concat as b
+
+type AppEffects :: [Effect]
+type AppEffects =
+  '[
+  ]
+
+type IOWrapperEffects :: [Effect]
+type IOWrapperEffects =
+  [
+    Web,
+    FileSystem,
+    GetTime,
+    GraphMetadataFilesystemOperations,
+    GraphMetadataFilesystemOperationsWriteDiff,
+    GraphDataFilesystemOperations
+  ]
+
+type FinalEffects :: [Effect]
+type FinalEffects =
+  [
+    Input Env,
+    Embed IO,
+    Embed (InputT IO),
+    Final (InputT IO)
+  ]
+
 -- | general function for interpreting the entire stack of effects in terms of real world things
 -- it takes a function that handles the errors, because that is necessary for
 -- this to have an arbitrary return type
@@ -126,7 +158,7 @@ runMainEffectsIO errorHandlingBehavior timeBehavior env v = do
           >>> runWebIO
           >>> runFileSystemIO
           >>> runStateInputIORefOf @IsDual #isDualized
-          >>> interpretConsoleIO
+          >>> interpretDisplayImageIO
           >>> timeBehavior
           >>> runLocableHistoryState
           >>> runStateInputIORefOf @History #history
diff --git a/cli/src/Executable/GraphEditor.hs b/cli/src/Executable/GraphEditor.hs
@@ -6,14 +6,14 @@ import Control.Lens hiding (index)
 import Control.Monad.Fix
 import DAL.Serialization (doesNodeExist, initializeGraph)
 import Effect.Console
-import Effect.Editor
-import Effect.FileSystem
-import Effect.FileTypeOracle
+import Effect.IOWrapper.Editor
+import Effect.IOWrapper.FileSystem
+import Effect.IOWrapper.FileTypeOracle
 import Effect.FreshNID
 import Effect.Interpreters
 import Effect.NodeLocated
-import Effect.Time
-import Effect.Web
+import Effect.IOWrapper.GetTime
+import Effect.IOWrapper.Web
 import Executable.GraphEditor.Completion
 import Executable.GraphEditor.Options
 import Graph.Effect
@@ -29,7 +29,7 @@ import qualified System.Console.Haskeline as H
 import System.Directory (createDirectoryIfMissing, doesDirectoryExist)
 import System.Environment.XDG.BaseDir (getUserDataDir)
 import System.Random (initStdGen, mkStdGen)
-import Effect.RawGraph
+import DAL.RawGraph
 
 ioExceptionHandler :: IOError -> IO (Maybe a)
 ioExceptionHandler _ = pure Nothing
diff --git a/cli/src/Executable/GraphEditor/Completion.hs b/cli/src/Executable/GraphEditor/Completion.hs
@@ -6,7 +6,7 @@ import Control.Lens
 import DAL.Serialization (nodesWithPrefix)
 import Effect.Interpreters
 import Effect.NodeLocated
-import Effect.Time
+import Effect.IOWrapper.GetTime
 import Error.UserError
 import Effect.Warn
 import Graph.Utils
diff --git a/cli/src/Graph/Export/FileSystem.hs b/cli/src/Graph/Export/FileSystem.hs
@@ -5,7 +5,7 @@ where
 
 import Data.Tree (Tree)
 import qualified Data.Tree as T
-import Effect.FileTypeOracle
+import Effect.IOWrapper.FileTypeOracle
 import Graph.Effect
 import Effect.Warn
 import qualified DAL.Serialization as S2
@@ -18,7 +18,7 @@ import System.FilePath (makeValid, splitFileName)
 import Error.UserError
 import Models.Connect
 import Models.Node
-import Effect.RawGraph
+import DAL.RawGraph
 
 -- | Like a DFS tree of the graph, but include duplciates unless they would form
 -- a cycle. Term Heterarchy comes from neuron zettelkasten
diff --git a/cli/src/Graph/Import/ByteString.hs b/cli/src/Graph/Import/ByteString.hs
@@ -2,9 +2,9 @@ module Graph.Import.ByteString where
 
 import Data.Digest.Pure.SHA
 import Effect.FreshNID
-import Effect.Time
+import Effect.IOWrapper.GetTime
 import Error.UserError
-import Effect.Web
+import Effect.IOWrapper.Web
 import Graph.Effect
 import Graph.SystemNodes
 import Graph.Time
diff --git a/cli/src/Graph/Import/FileSystem.hs b/cli/src/Graph/Import/FileSystem.hs
@@ -10,9 +10,9 @@ module Graph.Import.FileSystem where
 
 import Data.Digest.Pure.SHA
 import Effect.Console
-import Effect.FileSystem
+import Effect.IOWrapper.FileSystem
 import Effect.FreshNID
-import Effect.Time
+import Effect.IOWrapper.GetTime
 import Error.UserError
 import Graph.Effect
 import Graph.Import.ByteString
diff --git a/cli/src/Graph/Time.hs b/cli/src/Graph/Time.hs
@@ -2,7 +2,7 @@ module Graph.Time where
 
 import qualified Data.Set as Set
 import Effect.FreshNID
-import Effect.Time
+import Effect.IOWrapper.GetTime
 import Error.UserError
 import Graph.Effect
 import Graph.SystemNodes
diff --git a/cli/src/Lang/Command.hs b/cli/src/Lang/Command.hs
@@ -17,15 +17,15 @@ module Lang.Command where
 import Control.Monad (zipWithM_)
 import qualified DAL.Serialization as S2
 import Effect.Console
-import Effect.Editor
-import Effect.FileSystem
-import Effect.FileTypeOracle
+import Effect.IOWrapper.Editor
+import Effect.IOWrapper.FileSystem
+import Effect.IOWrapper.FileTypeOracle
 import Effect.FreshNID
 import Effect.NodeLocated
-import Effect.Time
+import Effect.IOWrapper.GetTime
 import Error.UserError
 import Effect.Warn
-import Effect.Web
+import Effect.IOWrapper.Web
 import GHC.Generics
 import Graph.Check
 import Graph.Effect
@@ -45,7 +45,7 @@ import Polysemy.Readline
 import Polysemy.State
 import qualified Utils.Extensibility as Extensibility
 import Utils.Singleton
-import Effect.RawGraph
+import DAL.RawGraph
 import Error.Missing
 
 data Command
diff --git a/cli/src/Utils/Extensibility.hs b/cli/src/Utils/Extensibility.hs
