From 21d5366fead4fca4024da589942a6c646b93f494 Mon Sep 17 00:00:00 2001
From: "Niels G. W. Serup" <ngws@metanohi.name>
Date: Sun, 6 Oct 2024 13:19:06 +0200
Subject: [PATCH] Put more types into IsFunctionIO

---
 byg/src/DependencyGenerator.hs |  4 ++--
 byg/src/Types/Dependency.hs    |  2 +-
 byg/src/Types/FunctionIO.hs    | 26 +++++++++++++++-----------
 3 files changed, 18 insertions(+), 14 deletions(-)

diff --git a/byg/src/DependencyGenerator.hs b/byg/src/DependencyGenerator.hs
index 66db183..6f2c129 100644
--- a/byg/src/DependencyGenerator.hs
+++ b/byg/src/DependencyGenerator.hs
@@ -101,10 +101,10 @@ inject x = genDependency (makeDependency NoToken (Inject (toValue x)))
 runFunction :: Function -> Token a -> DepGenM' b
 runFunction f input = genDependency (makeDependency input (Function f))
 
-runFunctionIO :: IsFunctionIO f => f -> Token a -> DepGenM' b
+runFunctionIO :: IsFunctionIO f a b => f -> Token a -> DepGenM' b
 runFunctionIO f input = genDependency (makeDependency input (FunctionIO f))
 
-runFunctionIO_ :: IsFunctionIO f => f -> Token a -> DepGenM ()
+runFunctionIO_ :: IsFunctionIO f a b => f -> Token a -> DepGenM ()
 runFunctionIO_ f input = tellDep $ makeDependency input (FunctionIO f) NoToken
 
 class TokenableTo t s | s -> t where
diff --git a/byg/src/Types/Dependency.hs b/byg/src/Types/Dependency.hs
index 0fa43a7..c763181 100644
--- a/byg/src/Types/Dependency.hs
+++ b/byg/src/Types/Dependency.hs
@@ -21,7 +21,7 @@ import Language.Haskell.TH.Syntax (Lift)
 
 data Action where
   Function :: Function -> Action
-  FunctionIO :: IsFunctionIO f => f -> Action
+  FunctionIO :: IsFunctionIO f a b => f -> Action
   Inject :: Value -> Action
   FilterComp :: Action
   UntupleFst :: Action
diff --git a/byg/src/Types/FunctionIO.hs b/byg/src/Types/FunctionIO.hs
index d9a89d1..e3f1352 100644
--- a/byg/src/Types/FunctionIO.hs
+++ b/byg/src/Types/FunctionIO.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FunctionalDependencies #-}
 module Types.FunctionIO
   ( IsFunctionIO(..)
   , ListDirectory(..)
@@ -10,20 +11,23 @@ module Types.FunctionIO
   , MakeDir(..)
   ) where
 
-import Types.Values
-import Types.Value (Value(..), toValue, makeImage)
+import Prelude hiding (String, FilePath)
 
+import Types.Values
+import Types.Value (Value(..), Valuable(..), makeImage)
+
+import Data.Text (Text)
 import qualified Data.Text.IO as T
 import qualified Codec.Picture as CP
 import System.Directory (listDirectory, doesDirectoryExist, createDirectory, copyFile)
 import Language.Haskell.TH.Syntax (Lift)
 
-class (Show f, Lift f) => IsFunctionIO f where
+class (Show f, Lift f, Valuable a, Valuable b) => IsFunctionIO f a b | f -> a b where
   evalFunctionIO :: f -> Value -> IO Value
   functionIOTouchesFilesystem :: f -> Bool
 
 data ListDirectory = ListDirectory deriving (Show, Lift)
-instance IsFunctionIO ListDirectory where
+instance IsFunctionIO ListDirectory FilePath [FilePath] where
   evalFunctionIO ListDirectory = \case
     String (StringWrapper s) ->
       (List . map (toValue . StringWrapper)) <$> listDirectory s
@@ -31,7 +35,7 @@ instance IsFunctionIO ListDirectory where
   functionIOTouchesFilesystem ListDirectory = False
 
 data IsDirectory = IsDirectory deriving (Show, Lift)
-instance IsFunctionIO IsDirectory where
+instance IsFunctionIO IsDirectory FilePath Bool where
   evalFunctionIO IsDirectory = \case
     String (StringWrapper s) ->
       Bool <$> doesDirectoryExist s
@@ -39,7 +43,7 @@ instance IsFunctionIO IsDirectory where
   functionIOTouchesFilesystem IsDirectory = False
 
 data ReadTextFile = ReadTextFile deriving (Show, Lift)
-instance IsFunctionIO ReadTextFile where
+instance IsFunctionIO ReadTextFile FilePath Text where
   evalFunctionIO ReadTextFile = \case
     String (StringWrapper s) ->
       Text <$> T.readFile s
@@ -47,7 +51,7 @@ instance IsFunctionIO ReadTextFile where
   functionIOTouchesFilesystem ReadTextFile = False
 
 data OpenImage = OpenImage deriving (Show, Lift)
-instance IsFunctionIO OpenImage where
+instance IsFunctionIO OpenImage FilePath Image where
   evalFunctionIO OpenImage = \case
     String (StringWrapper s) -> do
       imageOrig <- CP.readImage s
@@ -58,7 +62,7 @@ instance IsFunctionIO OpenImage where
   functionIOTouchesFilesystem OpenImage = False
 
 data SaveImage = SaveImage deriving (Show, Lift)
-instance IsFunctionIO SaveImage where
+instance IsFunctionIO SaveImage (Image, FilePath) () where
   evalFunctionIO SaveImage = \case
     Tuple (Image (ImageWrapper image), String (StringWrapper s)) -> do
       CP.saveJpgImage 90 s $ CP.ImageRGB8 image
@@ -67,7 +71,7 @@ instance IsFunctionIO SaveImage where
   functionIOTouchesFilesystem SaveImage = True
 
 data SaveTextFile = SaveTextFile deriving (Show, Lift)
-instance IsFunctionIO SaveTextFile where
+instance IsFunctionIO SaveTextFile (Text, FilePath) () where
   evalFunctionIO SaveTextFile = \case
     Tuple (Text t, String (StringWrapper s)) -> do
       T.writeFile s t
@@ -76,7 +80,7 @@ instance IsFunctionIO SaveTextFile where
   functionIOTouchesFilesystem SaveTextFile = True
 
 data CopyFile = CopyFile deriving (Show, Lift)
-instance IsFunctionIO CopyFile where
+instance IsFunctionIO CopyFile (FilePath, FilePath) () where
   evalFunctionIO CopyFile = \case
     Tuple (String (StringWrapper source), String (StringWrapper target)) -> do
       copyFile source target
@@ -85,7 +89,7 @@ instance IsFunctionIO CopyFile where
   functionIOTouchesFilesystem CopyFile = True
 
 data MakeDir = MakeDir deriving (Show, Lift)
-instance IsFunctionIO MakeDir where
+instance IsFunctionIO MakeDir FilePath () where
   evalFunctionIO MakeDir = \case
     String (StringWrapper s) -> do
       createDirectory s