Provide more building blocks and extend example
This commit is contained in:
parent
dad5724af8
commit
5bbcc924b7
|
@ -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)
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue