Put more types into IsFunctionIO

This commit is contained in:
Niels G. W. Serup 2024-10-06 13:19:06 +02:00
parent b84e45ed8f
commit 21d5366fea
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
3 changed files with 18 additions and 14 deletions

View File

@ -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

View File

@ -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

View File

@ -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