Have instance declarations be independent of Value

This commit is contained in:
Niels G. W. Serup 2024-10-06 13:25:09 +02:00
parent 21d5366fea
commit 381ecd5f03
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
2 changed files with 23 additions and 43 deletions

View File

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

View File

@ -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
evalFunctionIO OpenImage (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"
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
evalFunctionIO SaveImage (ImageWrapper image, StringWrapper s) =
CP.saveJpgImage 90 s $ CP.ImageRGB8 image
pure Empty
_ -> error "unexpected"
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
evalFunctionIO SaveTextFile (t, StringWrapper s) =
T.writeFile s t
pure Empty
_ -> error "unexpected"
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
evalFunctionIO CopyFile (StringWrapper source, StringWrapper target) =
copyFile source target
pure Empty
_ -> error "unexpected"
functionIOTouchesFilesystem CopyFile = True
data MakeDir = MakeDir deriving (Show, Lift)
instance IsFunctionIO MakeDir FilePath () where
evalFunctionIO MakeDir = \case
String (StringWrapper s) -> do
evalFunctionIO MakeDir (StringWrapper s) =
createDirectory s
pure Empty
_ -> error "unexpected"
functionIOTouchesFilesystem MakeDir = True