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
( ComputationM
, Token
, tupleTokens
, zipTokens
, evalComputationM
, inject
, mapComputationM
@ -30,10 +32,17 @@ deriving instance (Show a, Show b) => Show (TypedRun a b)
data Token a where
Token :: Int -> Token a
TupleToken :: Token a -> Token b -> Token (a, b)
ZipToken :: Token [a] -> Token [b] -> Token [(a, b)]
NoToken :: Token ()
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)
deriving (Show)

View File

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

View File

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

View File

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

View File

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