Provide more building blocks and extend example

This commit is contained in:
Niels G. W. Serup 2024-09-21 23:11:31 +02:00
parent dad5724af8
commit 5bbcc924b7
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
5 changed files with 17 additions and 8 deletions

View File

@ -2,6 +2,8 @@
module ComputationM module ComputationM
( ComputationM ( ComputationM
, Token , Token
, tupleTokens
, zipTokens
, evalComputationM , evalComputationM
, inject , inject
, mapComputationM , mapComputationM
@ -30,10 +32,17 @@ deriving instance (Show a, Show b) => Show (TypedRun a b)
data Token a where data Token a where
Token :: Int -> Token a Token :: Int -> Token a
TupleToken :: Token a -> Token b -> Token (a, b) TupleToken :: Token a -> Token b -> Token (a, b)
ZipToken :: Token [a] -> Token [b] -> Token [(a, b)]
NoToken :: Token () NoToken :: Token ()
deriving instance Show (Token a) deriving instance Show (Token a)
tupleTokens :: (Show a, Show b) => Token a -> Token b -> Token (a, b)
tupleTokens = TupleToken
zipTokens :: (Show a, Show b) => Token [a] -> Token [b] -> Token [(a, b)]
zipTokens = ZipToken
data Dependency a b = Dependency (Token a) (TypedRun a b) (Token b) data Dependency a b = Dependency (Token a) (TypedRun a b) (Token b)
deriving (Show) deriving (Show)

View File

@ -3,7 +3,6 @@ module Functions
( isImageFilename ( isImageFilename
, convertedImageFilename , convertedImageFilename
, listDirectory , listDirectory
, openImage
, convertImage , convertImage
, saveFile , saveFile
, runPandoc , runPandoc
@ -17,7 +16,6 @@ isImageFilename = runFunction IsImageFilename
convertedImageFilename = runFunction ConvertedImageFilename convertedImageFilename = runFunction ConvertedImageFilename
listDirectory = runFunctionIO ListDirectory listDirectory = runFunctionIO ListDirectory
openImage = runFunctionIO OpenImage
convertImage = runFunctionIO ConvertImage convertImage = runFunctionIO ConvertImage
saveFile = runFunctionIO SaveFile saveFile = runFunctionIO SaveFile
runPandoc = runFunctionIO RunPandoc runPandoc = runFunctionIO RunPandoc

View File

@ -1,5 +1,6 @@
module Main where module Main where
import Types
import ComputationM import ComputationM
import Functions import Functions
@ -7,16 +8,16 @@ handleRecipeDir :: Token FilePath -> ComputationM ()
handleRecipeDir dir = do handleRecipeDir dir = do
dirContents <- listDirectory dir dirContents <- listDirectory dir
imageFilenames <- filterComputationM isImageFilename dirContents imageFilenames <- filterComputationM isImageFilename dirContents
t <- inject ("hej", "hey.txt") convertedImageFilenames <- mapComputationM convertedImageFilename imageFilenames
saveFile t flip mapComputationM_ (zipTokens imageFilenames convertedImageFilenames) $ \files -> do
settings <- inject $ ResizeToWidth 800
convertImage $ tupleTokens files settings
test :: ComputationM () test :: ComputationM ()
test = do test = do
dir <- inject "retter" dir <- inject "retter"
dirContents <- listDirectory dir dirContents <- listDirectory dir
mapComputationM_ handleRecipeDir dirContents mapComputationM_ handleRecipeDir dirContents
t <- inject ("hej", "hey.txt")
saveFile t
main :: IO () main :: IO ()
main = mapM_ print $ evalComputationM test main = mapM_ print $ evalComputationM test

View File

@ -1,3 +1,4 @@
{-# OPTIONS_GHC -Wno-orphans #-}
module Sources where module Sources where
-- TODO: Figure out if any of this is useful. -- TODO: Figure out if any of this is useful.
@ -10,7 +11,7 @@ data Source a where
instance SourceState FilePath where instance SourceState FilePath where
stateOfSource = undefined stateOfSource = undefined
instance SourceState Image where instance SourceState ((FilePath, FilePath), ImageConversionSettings) where
stateOfSource = undefined stateOfSource = undefined
instance SourceState (String, FilePath) where instance SourceState (String, FilePath) where

View File

@ -3,7 +3,7 @@ module Types where
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
data Image = Image data ImageConversionSettings = ResizeToWidth Int
deriving (Show) deriving (Show)
class (SourceState a, Show f) => IsFunction f a b | f -> a b where class (SourceState a, Show f) => IsFunction f a b | f -> a b where