From fa06f0685a921a48a38621dc75d75f22d3b3ab54 Mon Sep 17 00:00:00 2001 From: "Niels G. W. Serup" Date: Sun, 6 Oct 2024 13:06:34 +0200 Subject: [PATCH] Allow easier FunctionIO plug and play --- byg/byg.cabal | 1 - byg/src/DependencyGenerator.hs | 18 +++--- byg/src/DependencyRunner.hs | 3 +- byg/src/Evaluation/FunctionIO.hs | 61 -------------------- byg/src/Types/Dependency.hs | 26 +++++---- byg/src/Types/FunctionIO.hs | 99 ++++++++++++++++++++++++++++---- 6 files changed, 113 insertions(+), 95 deletions(-) delete mode 100644 byg/src/Evaluation/FunctionIO.hs diff --git a/byg/byg.cabal b/byg/byg.cabal index 7552d31..0ba7d0c 100644 --- a/byg/byg.cabal +++ b/byg/byg.cabal @@ -29,7 +29,6 @@ library Types DependencyGenerator Evaluation.Function - Evaluation.FunctionIO DependencyRunner SiteGenerator Precomputer diff --git a/byg/src/DependencyGenerator.hs b/byg/src/DependencyGenerator.hs index 9a1eb5d..66db183 100644 --- a/byg/src/DependencyGenerator.hs +++ b/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 diff --git a/byg/src/DependencyRunner.hs b/byg/src/DependencyRunner.hs index 8cd5fb1..ac5d04d 100644 --- a/byg/src/DependencyRunner.hs +++ b/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 diff --git a/byg/src/Evaluation/FunctionIO.hs b/byg/src/Evaluation/FunctionIO.hs deleted file mode 100644 index 4104aa7..0000000 --- a/byg/src/Evaluation/FunctionIO.hs +++ /dev/null @@ -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 diff --git a/byg/src/Types/Dependency.hs b/byg/src/Types/Dependency.hs index 9dee251..0fa43a7 100644 --- a/byg/src/Types/Dependency.hs +++ b/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 diff --git a/byg/src/Types/FunctionIO.hs b/byg/src/Types/FunctionIO.hs index bb76d48..d9a89d1 100644 --- a/byg/src/Types/FunctionIO.hs +++ b/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