Allow easier FunctionIO plug and play

byg/byg.cabal

@@ -29,7 +29,6 @@ library
         Types
         DependencyGenerator
         Evaluation.Function
-        Evaluation.FunctionIO
         DependencyRunner
         SiteGenerator
         Precomputer

byg/src/DependencyGenerator.hs

@@ -56,7 +56,7 @@ import Types.Token (Token(..))
 import Types.Values
 import Types.Value (Valuable(..))
 import Types.Function (Function(..))
-import Types.FunctionIO (FunctionIO(..))
+import Types.FunctionIO
 import Types.Dependency (Action(..), Dependency, makeDependency, makeUToken)
 
 import Control.Monad.State (MonadState, State, runState, put, get)
@@ -101,11 +101,11 @@ inject x = genDependency (makeDependency NoToken (Inject (toValue x)))
 runFunction :: Function -> Token a -> DepGenM' b
 runFunction f input = genDependency (makeDependency input (Function f))
 
-runFunctionIO :: FunctionIO -> Token a -> DepGenM' b
+runFunctionIO :: IsFunctionIO f => f -> Token a -> DepGenM' b
 runFunctionIO f input = genDependency (makeDependency input (FunctionIO f))
 
-runFunctionIO' :: FunctionIO -> Token a -> DepGenM ()
-runFunctionIO' f input = tellDep $ makeDependency input (FunctionIO f) NoToken
+runFunctionIO_ :: IsFunctionIO f => f -> Token a -> DepGenM ()
+runFunctionIO_ f input = tellDep $ makeDependency input (FunctionIO f) NoToken
 
 class TokenableTo t s | s -> t where
   toToken :: s -> DepGenM' t
@@ -258,19 +258,19 @@ openImage :: TokenableTo FilePath a => a -> DepGenM' Image
 openImage a = runFunctionIO OpenImage =<< toToken a
 
 saveImage :: (TokenableTo Image a, TokenableTo FilePath b) => a -> b -> DepGenM ()
-saveImage a b = runFunctionIO' SaveImage =<< toTupleToken a b
+saveImage a b = runFunctionIO_ SaveImage =<< toTupleToken a b
 
 saveTextFile :: (TokenableTo Text a, TokenableTo FilePath b) => a -> b -> DepGenM ()
-saveTextFile a b = runFunctionIO' SaveTextFile =<< toTupleToken a b
+saveTextFile a b = runFunctionIO_ SaveTextFile =<< toTupleToken a b
 
 copyFile :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM ()
-copyFile a b = runFunctionIO' CopyFile =<< toTupleToken a b
+copyFile a b = runFunctionIO_ CopyFile =<< toTupleToken a b
 
 copyFile' :: Token (FilePath, FilePath) -> DepGenM ()
-copyFile' = runFunctionIO' CopyFile
+copyFile' = runFunctionIO_ CopyFile
 
 makeDir :: TokenableTo FilePath a => a -> DepGenM ()
-makeDir a = runFunctionIO' MakeDir =<< toToken a
+makeDir a = runFunctionIO_ MakeDir =<< toToken a
 
 
 hasExtension :: (TokenableTo [String] a, TokenableTo FilePath b) => a -> b -> DepGenM' Bool

byg/src/DependencyRunner.hs

@@ -4,10 +4,9 @@ module DependencyRunner
   , runDepRunMIO
   ) where
 
-import Types (Value(..), fromValue)
+import Types (Value(..), fromValue, evalFunctionIO)
 import Types.Dependency
 import Evaluation.Function
-import Evaluation.FunctionIO
 
 import Data.Map (Map)
 import qualified Data.Map as M

byg/src/Evaluation/FunctionIO.hs

@@ -1,61 +0,0 @@
-module Evaluation.FunctionIO
-  ( evalFunctionIO
-  , functionIOTouchesFilesystem
-  ) where
-
-import Prelude hiding (String, FilePath)
-
-import Types.Values
-import Types.FunctionIO
-import Types.Value (Value(..), toValue, makeImage)
-
-import qualified Data.Text.IO as T
-import qualified Codec.Picture as CP
-import System.Directory (listDirectory, doesDirectoryExist, createDirectory, copyFile)
-
-evalFunctionIO :: FunctionIO -> Value -> IO Value
-evalFunctionIO f x = case (f, x) of
-  (ListDirectory, String (StringWrapper s)) ->
-    (List . map (toValue . StringWrapper)) <$> listDirectory s
-
-  (IsDirectory, String (StringWrapper s)) ->
-    Bool <$> doesDirectoryExist s
-
-  (ReadTextFile, String (StringWrapper s)) ->
-    Text <$> T.readFile s
-
-  (OpenImage, String (StringWrapper s)) -> do
-    imageOrig <- CP.readImage s
-    case imageOrig of
-      Left e -> error ("unexpected error: " ++ e)
-      Right image -> pure $ makeImage $ CP.convertRGB8 image
-
-  (SaveImage, Tuple (Image (ImageWrapper image), String (StringWrapper s))) -> do
-    CP.saveJpgImage 90 s $ CP.ImageRGB8 image
-    pure Empty
-
-  (SaveTextFile, Tuple (Text t, String (StringWrapper s))) -> do
-    T.writeFile s t
-    pure Empty
-
-  (CopyFile, Tuple (String (StringWrapper source), String (StringWrapper target))) -> do
-    copyFile source target
-    pure Empty
-
-  (MakeDir, String (StringWrapper s)) -> do
-    createDirectory s
-    pure Empty
-
-  _ ->
-    error ("unexpected combination of function and argument type; got function " ++ show f ++ " with argument " ++ show x)
-
-functionIOTouchesFilesystem :: FunctionIO -> Bool
-functionIOTouchesFilesystem = \case
-  ListDirectory -> False
-  IsDirectory -> False
-  ReadTextFile -> False
-  OpenImage -> False
-  SaveImage -> True
-  SaveTextFile -> True
-  CopyFile -> True
-  MakeDir -> True

byg/src/Types/Dependency.hs

@@ -12,24 +12,26 @@ module Types.Dependency
 import Types.Token (Token(..))
 import Types.Value (Value)
 import Types.Function (Function)
-import Types.FunctionIO (FunctionIO)
-import Evaluation.FunctionIO (functionIOTouchesFilesystem)
+import Types.FunctionIO (IsFunctionIO(..))
 
 import Text.Printf (printf)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Language.Haskell.TH.Syntax (Lift)
 
-data Action = Function Function
-            | FunctionIO FunctionIO
-            | Inject Value
-            | FilterComp
-            | UntupleFst
-            | UntupleSnd
-            | UnzipFst
-            | UnzipSnd
-            | MapComp [Dependency] UToken UToken
-  deriving (Show, Lift)
+data Action where
+  Function :: Function -> Action
+  FunctionIO :: IsFunctionIO f => f -> Action
+  Inject :: Value -> Action
+  FilterComp :: Action
+  UntupleFst :: Action
+  UntupleSnd :: Action
+  UnzipFst :: Action
+  UnzipSnd :: Action
+  MapComp :: [Dependency] -> UToken -> UToken -> Action
+
+deriving instance Show Action
+deriving instance Lift Action
 
 data UToken = UToken Int
             | UTupleToken UToken UToken

byg/src/Types/FunctionIO.hs

@@ -1,15 +1,94 @@
 module Types.FunctionIO
-  ( FunctionIO(..)
+  ( IsFunctionIO(..)
+  , ListDirectory(..)
+  , IsDirectory(..)
+  , ReadTextFile(..)
+  , OpenImage(..)
+  , SaveImage(..)
+  , SaveTextFile(..)
+  , CopyFile(..)
+  , MakeDir(..)
   ) where
 
+import Types.Values
+import Types.Value (Value(..), toValue, makeImage)
+
+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)
 
-data FunctionIO = ListDirectory
-                | IsDirectory
-                | ReadTextFile
-                | OpenImage
-                | SaveImage
-                | SaveTextFile
-                | CopyFile
-                | MakeDir
-  deriving (Show, Lift)
+class (Show f, Lift f) => IsFunctionIO f where
+  evalFunctionIO :: f -> Value -> IO Value
+  functionIOTouchesFilesystem :: f -> Bool
+
+data ListDirectory = ListDirectory deriving (Show, Lift)
+instance IsFunctionIO ListDirectory where
+  evalFunctionIO ListDirectory = \case
+    String (StringWrapper s) ->
+      (List . map (toValue . StringWrapper)) <$> listDirectory s
+    _ -> error "unexpected"
+  functionIOTouchesFilesystem ListDirectory = False
+
+data IsDirectory = IsDirectory deriving (Show, Lift)
+instance IsFunctionIO IsDirectory where
+  evalFunctionIO IsDirectory = \case
+    String (StringWrapper s) ->
+      Bool <$> doesDirectoryExist s
+    _ -> error "unexpected"
+  functionIOTouchesFilesystem IsDirectory = False
+
+data ReadTextFile = ReadTextFile deriving (Show, Lift)
+instance IsFunctionIO ReadTextFile where
+  evalFunctionIO ReadTextFile = \case
+    String (StringWrapper s) ->
+      Text <$> T.readFile s
+    _ -> error "unexpected"
+  functionIOTouchesFilesystem ReadTextFile = False
+
+data OpenImage = OpenImage deriving (Show, Lift)
+instance IsFunctionIO OpenImage 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"
+  functionIOTouchesFilesystem OpenImage = False
+
+data SaveImage = SaveImage deriving (Show, Lift)
+instance IsFunctionIO SaveImage where
+  evalFunctionIO SaveImage = \case
+    Tuple (Image (ImageWrapper image), String (StringWrapper s)) -> do
+      CP.saveJpgImage 90 s $ CP.ImageRGB8 image
+      pure Empty
+    _ -> error "unexpected"
+  functionIOTouchesFilesystem SaveImage = True
+
+data SaveTextFile = SaveTextFile deriving (Show, Lift)
+instance IsFunctionIO SaveTextFile where
+  evalFunctionIO SaveTextFile = \case
+    Tuple (Text t, String (StringWrapper s)) -> do
+      T.writeFile s t
+      pure Empty
+    _ -> error "unexpected"
+  functionIOTouchesFilesystem SaveTextFile = True
+
+data CopyFile = CopyFile deriving (Show, Lift)
+instance IsFunctionIO CopyFile where
+  evalFunctionIO CopyFile = \case
+    Tuple (String (StringWrapper source), String (StringWrapper target)) -> do
+      copyFile source target
+      pure Empty
+    _ -> error "unexpected"
+  functionIOTouchesFilesystem CopyFile = True
+
+data MakeDir = MakeDir deriving (Show, Lift)
+instance IsFunctionIO MakeDir where
+  evalFunctionIO MakeDir = \case
+    String (StringWrapper s) -> do
+      createDirectory s
+      pure Empty
+    _ -> error "unexpected"
+  functionIOTouchesFilesystem MakeDir = True