Put more types into IsFunctionIO
This commit is contained in:
		@@ -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
 | 
				
			||||||
 
 | 
				
			|||||||
		Reference in New Issue
	
	Block a user