From 381ecd5f03f83040c1604ae19197a164d12171fd Mon Sep 17 00:00:00 2001
From: "Niels G. W. Serup" <ngws@metanohi.name>
Date: Sun, 6 Oct 2024 13:25:09 +0200
Subject: [PATCH] Have instance declarations be independent of Value

---
 byg/src/DependencyRunner.hs |  4 +--
 byg/src/Types/FunctionIO.hs | 62 +++++++++++++------------------------
 2 files changed, 23 insertions(+), 43 deletions(-)

diff --git a/byg/src/DependencyRunner.hs b/byg/src/DependencyRunner.hs
index ac5d04d..60f5934 100644
--- a/byg/src/DependencyRunner.hs
+++ b/byg/src/DependencyRunner.hs
@@ -4,7 +4,7 @@ module DependencyRunner
   , runDepRunMIO
   ) where
 
-import Types (Value(..), fromValue, evalFunctionIO)
+import Types (Value(..), Valuable(..), evalFunctionIO)
 import Types.Dependency
 import Evaluation.Function
 
@@ -84,7 +84,7 @@ runAction action input = case action of
   Function f ->
     pure $ evalFunction f input
   FunctionIO f ->
-    liftIO $ evalFunctionIO f input
+    liftIO (toValue <$> evalFunctionIO f (fromValue input))
   Inject v ->
     pure v
   FilterComp ->
diff --git a/byg/src/Types/FunctionIO.hs b/byg/src/Types/FunctionIO.hs
index e3f1352..3e4284d 100644
--- a/byg/src/Types/FunctionIO.hs
+++ b/byg/src/Types/FunctionIO.hs
@@ -14,7 +14,7 @@ module Types.FunctionIO
 import Prelude hiding (String, FilePath)
 
 import Types.Values
-import Types.Value (Value(..), Valuable(..), makeImage)
+import Types.Value (Valuable)
 
 import Data.Text (Text)
 import qualified Data.Text.IO as T
@@ -23,76 +23,56 @@ import System.Directory (listDirectory, doesDirectoryExist, createDirectory, cop
 import Language.Haskell.TH.Syntax (Lift)
 
 class (Show f, Lift f, Valuable a, Valuable b) => IsFunctionIO f a b | f -> a b where
-  evalFunctionIO :: f -> Value -> IO Value
+  evalFunctionIO :: f -> a -> IO b
   functionIOTouchesFilesystem :: f -> Bool
 
 data ListDirectory = ListDirectory deriving (Show, Lift)
 instance IsFunctionIO ListDirectory FilePath [FilePath] where
-  evalFunctionIO ListDirectory = \case
-    String (StringWrapper s) ->
-      (List . map (toValue . StringWrapper)) <$> listDirectory s
-    _ -> error "unexpected"
+  evalFunctionIO ListDirectory (StringWrapper s) =
+    map StringWrapper <$> listDirectory s
   functionIOTouchesFilesystem ListDirectory = False
 
 data IsDirectory = IsDirectory deriving (Show, Lift)
 instance IsFunctionIO IsDirectory FilePath Bool where
-  evalFunctionIO IsDirectory = \case
-    String (StringWrapper s) ->
-      Bool <$> doesDirectoryExist s
-    _ -> error "unexpected"
+  evalFunctionIO IsDirectory (StringWrapper s) =
+    doesDirectoryExist s
   functionIOTouchesFilesystem IsDirectory = False
 
 data ReadTextFile = ReadTextFile deriving (Show, Lift)
 instance IsFunctionIO ReadTextFile FilePath Text where
-  evalFunctionIO ReadTextFile = \case
-    String (StringWrapper s) ->
-      Text <$> T.readFile s
-    _ -> error "unexpected"
+  evalFunctionIO ReadTextFile (StringWrapper s) =
+    T.readFile s
   functionIOTouchesFilesystem ReadTextFile = False
 
 data OpenImage = OpenImage deriving (Show, Lift)
 instance IsFunctionIO OpenImage FilePath Image where
-  evalFunctionIO OpenImage = \case
-    String (StringWrapper s) -> do
-      imageOrig <- CP.readImage s
-      case imageOrig of
-        Left e -> error ("unexpected error: " ++ e)
-        Right image -> pure $ makeImage $ CP.convertRGB8 image
-    _ -> error "unexpected"
+  evalFunctionIO OpenImage (StringWrapper s) = do
+    imageOrig <- CP.readImage s
+    case imageOrig of
+      Left e -> error ("unexpected error: " ++ e)
+      Right image -> pure $ ImageWrapper $ CP.convertRGB8 image
   functionIOTouchesFilesystem OpenImage = False
 
 data SaveImage = SaveImage deriving (Show, Lift)
 instance IsFunctionIO SaveImage (Image, FilePath) () where
-  evalFunctionIO SaveImage = \case
-    Tuple (Image (ImageWrapper image), String (StringWrapper s)) -> do
-      CP.saveJpgImage 90 s $ CP.ImageRGB8 image
-      pure Empty
-    _ -> error "unexpected"
+  evalFunctionIO SaveImage (ImageWrapper image, StringWrapper s) =
+    CP.saveJpgImage 90 s $ CP.ImageRGB8 image
   functionIOTouchesFilesystem SaveImage = True
 
 data SaveTextFile = SaveTextFile deriving (Show, Lift)
 instance IsFunctionIO SaveTextFile (Text, FilePath) () where
-  evalFunctionIO SaveTextFile = \case
-    Tuple (Text t, String (StringWrapper s)) -> do
-      T.writeFile s t
-      pure Empty
-    _ -> error "unexpected"
+  evalFunctionIO SaveTextFile (t, StringWrapper s) =
+    T.writeFile s t
   functionIOTouchesFilesystem SaveTextFile = True
 
 data CopyFile = CopyFile deriving (Show, Lift)
 instance IsFunctionIO CopyFile (FilePath, FilePath) () where
-  evalFunctionIO CopyFile = \case
-    Tuple (String (StringWrapper source), String (StringWrapper target)) -> do
-      copyFile source target
-      pure Empty
-    _ -> error "unexpected"
+  evalFunctionIO CopyFile (StringWrapper source, StringWrapper target) =
+    copyFile source target
   functionIOTouchesFilesystem CopyFile = True
 
 data MakeDir = MakeDir deriving (Show, Lift)
 instance IsFunctionIO MakeDir FilePath () where
-  evalFunctionIO MakeDir = \case
-    String (StringWrapper s) -> do
-      createDirectory s
-      pure Empty
-    _ -> error "unexpected"
+  evalFunctionIO MakeDir (StringWrapper s) =
+    createDirectory s
   functionIOTouchesFilesystem MakeDir = True