Have instance declarations be independent of Value
This commit is contained in:
parent
21d5366fea
commit
381ecd5f03
|
@ -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 ->
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue