Put more types into IsFunctionIO
This commit is contained in:
parent
b84e45ed8f
commit
21d5366fea
|
@ -101,10 +101,10 @@ inject x = genDependency (makeDependency NoToken (Inject (toValue x)))
|
||||||
runFunction :: Function -> Token a -> DepGenM' b
|
runFunction :: Function -> Token a -> DepGenM' b
|
||||||
runFunction f input = genDependency (makeDependency input (Function f))
|
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 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
|
runFunctionIO_ f input = tellDep $ makeDependency input (FunctionIO f) NoToken
|
||||||
|
|
||||||
class TokenableTo t s | s -> t where
|
class TokenableTo t s | s -> t where
|
||||||
|
|
|
@ -21,7 +21,7 @@ import Language.Haskell.TH.Syntax (Lift)
|
||||||
|
|
||||||
data Action where
|
data Action where
|
||||||
Function :: Function -> Action
|
Function :: Function -> Action
|
||||||
FunctionIO :: IsFunctionIO f => f -> Action
|
FunctionIO :: IsFunctionIO f a b => f -> Action
|
||||||
Inject :: Value -> Action
|
Inject :: Value -> Action
|
||||||
FilterComp :: Action
|
FilterComp :: Action
|
||||||
UntupleFst :: Action
|
UntupleFst :: Action
|
||||||
|
|
|
@ -1,3 +1,4 @@
|
||||||
|
{-# LANGUAGE FunctionalDependencies #-}
|
||||||
module Types.FunctionIO
|
module Types.FunctionIO
|
||||||
( IsFunctionIO(..)
|
( IsFunctionIO(..)
|
||||||
, ListDirectory(..)
|
, ListDirectory(..)
|
||||||
|
@ -10,20 +11,23 @@ module Types.FunctionIO
|
||||||
, MakeDir(..)
|
, MakeDir(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Types.Values
|
import Prelude hiding (String, FilePath)
|
||||||
import Types.Value (Value(..), toValue, makeImage)
|
|
||||||
|
|
||||||
|
import Types.Values
|
||||||
|
import Types.Value (Value(..), Valuable(..), makeImage)
|
||||||
|
|
||||||
|
import Data.Text (Text)
|
||||||
import qualified Data.Text.IO as T
|
import qualified Data.Text.IO as T
|
||||||
import qualified Codec.Picture as CP
|
import qualified Codec.Picture as CP
|
||||||
import System.Directory (listDirectory, doesDirectoryExist, createDirectory, copyFile)
|
import System.Directory (listDirectory, doesDirectoryExist, createDirectory, copyFile)
|
||||||
import Language.Haskell.TH.Syntax (Lift)
|
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
|
evalFunctionIO :: f -> Value -> IO Value
|
||||||
functionIOTouchesFilesystem :: f -> Bool
|
functionIOTouchesFilesystem :: f -> Bool
|
||||||
|
|
||||||
data ListDirectory = ListDirectory deriving (Show, Lift)
|
data ListDirectory = ListDirectory deriving (Show, Lift)
|
||||||
instance IsFunctionIO ListDirectory where
|
instance IsFunctionIO ListDirectory FilePath [FilePath] where
|
||||||
evalFunctionIO ListDirectory = \case
|
evalFunctionIO ListDirectory = \case
|
||||||
String (StringWrapper s) ->
|
String (StringWrapper s) ->
|
||||||
(List . map (toValue . StringWrapper)) <$> listDirectory s
|
(List . map (toValue . StringWrapper)) <$> listDirectory s
|
||||||
|
@ -31,7 +35,7 @@ instance IsFunctionIO ListDirectory where
|
||||||
functionIOTouchesFilesystem ListDirectory = False
|
functionIOTouchesFilesystem ListDirectory = False
|
||||||
|
|
||||||
data IsDirectory = IsDirectory deriving (Show, Lift)
|
data IsDirectory = IsDirectory deriving (Show, Lift)
|
||||||
instance IsFunctionIO IsDirectory where
|
instance IsFunctionIO IsDirectory FilePath Bool where
|
||||||
evalFunctionIO IsDirectory = \case
|
evalFunctionIO IsDirectory = \case
|
||||||
String (StringWrapper s) ->
|
String (StringWrapper s) ->
|
||||||
Bool <$> doesDirectoryExist s
|
Bool <$> doesDirectoryExist s
|
||||||
|
@ -39,7 +43,7 @@ instance IsFunctionIO IsDirectory where
|
||||||
functionIOTouchesFilesystem IsDirectory = False
|
functionIOTouchesFilesystem IsDirectory = False
|
||||||
|
|
||||||
data ReadTextFile = ReadTextFile deriving (Show, Lift)
|
data ReadTextFile = ReadTextFile deriving (Show, Lift)
|
||||||
instance IsFunctionIO ReadTextFile where
|
instance IsFunctionIO ReadTextFile FilePath Text where
|
||||||
evalFunctionIO ReadTextFile = \case
|
evalFunctionIO ReadTextFile = \case
|
||||||
String (StringWrapper s) ->
|
String (StringWrapper s) ->
|
||||||
Text <$> T.readFile s
|
Text <$> T.readFile s
|
||||||
|
@ -47,7 +51,7 @@ instance IsFunctionIO ReadTextFile where
|
||||||
functionIOTouchesFilesystem ReadTextFile = False
|
functionIOTouchesFilesystem ReadTextFile = False
|
||||||
|
|
||||||
data OpenImage = OpenImage deriving (Show, Lift)
|
data OpenImage = OpenImage deriving (Show, Lift)
|
||||||
instance IsFunctionIO OpenImage where
|
instance IsFunctionIO OpenImage FilePath Image where
|
||||||
evalFunctionIO OpenImage = \case
|
evalFunctionIO OpenImage = \case
|
||||||
String (StringWrapper s) -> do
|
String (StringWrapper s) -> do
|
||||||
imageOrig <- CP.readImage s
|
imageOrig <- CP.readImage s
|
||||||
|
@ -58,7 +62,7 @@ instance IsFunctionIO OpenImage where
|
||||||
functionIOTouchesFilesystem OpenImage = False
|
functionIOTouchesFilesystem OpenImage = False
|
||||||
|
|
||||||
data SaveImage = SaveImage deriving (Show, Lift)
|
data SaveImage = SaveImage deriving (Show, Lift)
|
||||||
instance IsFunctionIO SaveImage where
|
instance IsFunctionIO SaveImage (Image, FilePath) () where
|
||||||
evalFunctionIO SaveImage = \case
|
evalFunctionIO SaveImage = \case
|
||||||
Tuple (Image (ImageWrapper image), String (StringWrapper s)) -> do
|
Tuple (Image (ImageWrapper image), String (StringWrapper s)) -> do
|
||||||
CP.saveJpgImage 90 s $ CP.ImageRGB8 image
|
CP.saveJpgImage 90 s $ CP.ImageRGB8 image
|
||||||
|
@ -67,7 +71,7 @@ instance IsFunctionIO SaveImage where
|
||||||
functionIOTouchesFilesystem SaveImage = True
|
functionIOTouchesFilesystem SaveImage = True
|
||||||
|
|
||||||
data SaveTextFile = SaveTextFile deriving (Show, Lift)
|
data SaveTextFile = SaveTextFile deriving (Show, Lift)
|
||||||
instance IsFunctionIO SaveTextFile where
|
instance IsFunctionIO SaveTextFile (Text, FilePath) () where
|
||||||
evalFunctionIO SaveTextFile = \case
|
evalFunctionIO SaveTextFile = \case
|
||||||
Tuple (Text t, String (StringWrapper s)) -> do
|
Tuple (Text t, String (StringWrapper s)) -> do
|
||||||
T.writeFile s t
|
T.writeFile s t
|
||||||
|
@ -76,7 +80,7 @@ instance IsFunctionIO SaveTextFile where
|
||||||
functionIOTouchesFilesystem SaveTextFile = True
|
functionIOTouchesFilesystem SaveTextFile = True
|
||||||
|
|
||||||
data CopyFile = CopyFile deriving (Show, Lift)
|
data CopyFile = CopyFile deriving (Show, Lift)
|
||||||
instance IsFunctionIO CopyFile where
|
instance IsFunctionIO CopyFile (FilePath, FilePath) () where
|
||||||
evalFunctionIO CopyFile = \case
|
evalFunctionIO CopyFile = \case
|
||||||
Tuple (String (StringWrapper source), String (StringWrapper target)) -> do
|
Tuple (String (StringWrapper source), String (StringWrapper target)) -> do
|
||||||
copyFile source target
|
copyFile source target
|
||||||
|
@ -85,7 +89,7 @@ instance IsFunctionIO CopyFile where
|
||||||
functionIOTouchesFilesystem CopyFile = True
|
functionIOTouchesFilesystem CopyFile = True
|
||||||
|
|
||||||
data MakeDir = MakeDir deriving (Show, Lift)
|
data MakeDir = MakeDir deriving (Show, Lift)
|
||||||
instance IsFunctionIO MakeDir where
|
instance IsFunctionIO MakeDir FilePath () where
|
||||||
evalFunctionIO MakeDir = \case
|
evalFunctionIO MakeDir = \case
|
||||||
String (StringWrapper s) -> do
|
String (StringWrapper s) -> do
|
||||||
createDirectory s
|
createDirectory s
|
||||||
|
|
Loading…
Reference in New Issue