Work on correctly avoiding doing early work if later IO work does not need it
Not at all there
This commit is contained in:
parent
5862fe32bc
commit
0f0bde5f18
|
|
@ -43,6 +43,7 @@ library
|
|||
, containers
|
||||
, text
|
||||
, directory
|
||||
, time
|
||||
, blaze-html
|
||||
, pandoc-types
|
||||
, pandoc
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@ pkgs.haskell.lib.overrideCabal
|
|||
(haskell.callCabal2nix "byg" ./. { })
|
||||
(_: {
|
||||
configureFlags = [
|
||||
"--ghc-option=-Werror"
|
||||
# "--ghc-option=-Werror"
|
||||
"--ghc-option=-O2"
|
||||
];
|
||||
doHaddock = false;
|
||||
|
|
|
|||
|
|
@ -3,9 +3,11 @@ module DependencyRunner
|
|||
( DepRunM
|
||||
, runDeps
|
||||
, runDepRunMIO
|
||||
, extractSndToken
|
||||
, extractSndTokenAsList
|
||||
) where
|
||||
|
||||
import Types (evalFunctionIO)
|
||||
import Types (evalFunctionIO, functionIOReads, functionIOWrites)
|
||||
import Types.Value
|
||||
import Types.Token
|
||||
import Types.Dependency
|
||||
|
|
@ -13,65 +15,149 @@ import Types.Dependency
|
|||
import Type.Reflection (Typeable)
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as M
|
||||
import Control.Monad (void, forM)
|
||||
import Data.Maybe (catMaybes)
|
||||
import Control.Monad (void, forM, filterM)
|
||||
import Control.Monad.State (MonadState, MonadIO, StateT, evalStateT, get, modify, liftIO)
|
||||
import Control.Monad.Writer (MonadWriter, WriterT, runWriterT, tell)
|
||||
import System.Directory (getModificationTime)
|
||||
import Data.Time.Clock (UTCTime(..))
|
||||
import qualified System.Directory as SD
|
||||
|
||||
data ValueExistence = Evaluated Value
|
||||
| NotEvaluated (DepRunM Value)
|
||||
data LastUpdated = Never
|
||||
| NeverDebug String
|
||||
| NeverInput
|
||||
| At UTCTime
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
newtype DepRunM a = DepRunM { unDepRunM :: StateT (Map Int ValueExistence) IO a }
|
||||
deriving (Functor, Applicative, Monad, MonadIO, MonadState (Map Int ValueExistence))
|
||||
data ValueExistence = Evaluated Value LastUpdated
|
||||
| NotEvaluated (LastUpdated -> DepRunM (Maybe (Value, LastUpdated)))
|
||||
|
||||
newtype DepRunM a = DepRunM { unDepRunM :: WriterT [FilePath] (StateT (Map Int ValueExistence) IO) a }
|
||||
deriving (Functor, Applicative, Monad, MonadIO,
|
||||
MonadState (Map Int ValueExistence),
|
||||
MonadWriter [FilePath])
|
||||
|
||||
runDeps :: [Dependency] -> DepRunM ()
|
||||
runDeps = mapM_ runDep
|
||||
|
||||
runDepRunMIO :: DepRunM a -> IO a
|
||||
runDepRunMIO m = evalStateT (unDepRunM m) M.empty
|
||||
runDepRunMIO :: DepRunM a -> IO (a, [FilePath])
|
||||
runDepRunMIO m = evalStateT (runWriterT (unDepRunM m)) M.empty
|
||||
|
||||
evaluate :: ValueExistence -> DepRunM Value
|
||||
evaluate = \case
|
||||
Evaluated v -> pure v
|
||||
NotEvaluated m -> m
|
||||
evaluate :: LastUpdated -> ValueExistence -> DepRunM (Maybe (Value, LastUpdated))
|
||||
evaluate luFuture = \case
|
||||
Evaluated v lu -> pure (Just (v, lu))
|
||||
NotEvaluated m -> m luFuture
|
||||
|
||||
runDep :: Dependency -> DepRunM ()
|
||||
runDep (Dependency _ a action _ b) =
|
||||
if actionWritesAny action
|
||||
then void m
|
||||
then void (m Never)
|
||||
else putTokenValue b $ NotEvaluated m
|
||||
where m :: DepRunM Value
|
||||
m = do
|
||||
input <- getTokenValue a
|
||||
result <- runAction action input
|
||||
putTokenValue b $ Evaluated result
|
||||
liftIO $ do
|
||||
putStrLn ("input: " ++ show input)
|
||||
putStrLn ("action: " ++ show action)
|
||||
putStrLn ("output: " ++ show result)
|
||||
putStrLn "----------"
|
||||
pure result
|
||||
where m :: LastUpdated -> DepRunM (Maybe (Value, LastUpdated))
|
||||
m luFuture = do
|
||||
m <- runAction action a luFuture
|
||||
case m of
|
||||
Just (result, luResult) -> do
|
||||
putTokenValue b $ Evaluated result luResult
|
||||
pure $ Just (result, luResult)
|
||||
Nothing ->
|
||||
pure Nothing
|
||||
|
||||
getTokenValueByIndex :: Int -> DepRunM Value
|
||||
getTokenValueByIndex i = do
|
||||
extractSndToken :: Token (a, b) -> Token b
|
||||
extractSndToken = \case
|
||||
TupleToken _ b ->
|
||||
b
|
||||
_ ->
|
||||
error "unsupported"
|
||||
|
||||
extractSndTokenAsList :: (Show b, Typeable b) => Token (a, b) -> Token [b]
|
||||
extractSndTokenAsList = ListToken . (: []) . extractSndToken
|
||||
|
||||
getTokenValueByIndex :: LastUpdated -> Int -> DepRunM (Maybe (Value, LastUpdated))
|
||||
getTokenValueByIndex luFuture i = do
|
||||
m <- get
|
||||
evaluate (m M.! i)
|
||||
case m M.!? i of
|
||||
Nothing -> pure Nothing
|
||||
Just x -> evaluate luFuture x
|
||||
|
||||
minimumOrNever :: [LastUpdated] -> LastUpdated
|
||||
minimumOrNever = \case
|
||||
[] -> Never
|
||||
times -> minimum times
|
||||
|
||||
maximumOrNever :: [LastUpdated] -> LastUpdated
|
||||
maximumOrNever = \case
|
||||
[] -> Never
|
||||
times -> maximum times
|
||||
|
||||
maximumOrNever' :: [UTCTime] -> LastUpdated
|
||||
maximumOrNever' = maximumOrNever . map At
|
||||
|
||||
getTokenValueRaw :: LastUpdated -> Token a -> DepRunM (Maybe (a, LastUpdated))
|
||||
getTokenValueRaw luFuture token = case token of
|
||||
Token i -> do
|
||||
m <- getTokenValueByIndex luFuture i
|
||||
pure $ do (a, lu) <- m
|
||||
pure (fromValue a, lu)
|
||||
|
||||
getTokenValueRaw :: Token a -> DepRunM a
|
||||
getTokenValueRaw token = case token of
|
||||
Token i ->
|
||||
fromValue <$> getTokenValueByIndex i
|
||||
TupleToken a b -> do
|
||||
(,) <$> getTokenValueRaw a <*> getTokenValueRaw b
|
||||
ZipToken a b -> do
|
||||
zip <$> getTokenValueRaw a <*> getTokenValueRaw b
|
||||
ListToken ts -> do
|
||||
mapM getTokenValueRaw ts
|
||||
NoToken ->
|
||||
pure ()
|
||||
m0 <- getTokenValueRaw luFuture a
|
||||
m1 <- getTokenValueRaw luFuture b
|
||||
case (m0, m1) of
|
||||
(Just (a', luA), Just (b', luB)) ->
|
||||
pure $ Just ((a', b'), max luA luB)
|
||||
(Just (a', luA), Nothing) -> do -- | luA /= NeverInput -> do
|
||||
r <- getTokenValueRaw (NeverDebug (show (a', luA))) b
|
||||
pure $ case r of
|
||||
Nothing -> error ("unexpected " ++ show b ++ " (" ++ show (a', luA) ++ ")")
|
||||
Just (b', luB) -> Just ((a', b'), max luA luB)
|
||||
(Nothing, Just (b', luB)) -> do -- | luB /= NeverInput -> do
|
||||
r <- getTokenValueRaw (NeverDebug (show (b', luB))) a
|
||||
pure $ case r of
|
||||
Nothing -> error "unexpected"
|
||||
Just (a', luA) -> Just ((a', b'), max luA luB)
|
||||
_ ->
|
||||
pure $ Nothing
|
||||
|
||||
getTokenValue :: Token a -> DepRunM Value
|
||||
getTokenValue token = case token of
|
||||
ZipToken a b -> do
|
||||
m0 <- getTokenValueRaw luFuture a
|
||||
m1 <- getTokenValueRaw luFuture b
|
||||
case (m0, m1) of
|
||||
(Just (a', luA), Just (b', luB)) ->
|
||||
pure $ Just (zip a' b', max luA luB)
|
||||
(Just (a', luA), Nothing) -> do -- | luA /= NeverInput -> do
|
||||
r <- getTokenValueRaw Never b
|
||||
pure $ case r of
|
||||
Nothing -> error "unexpected"
|
||||
Just (b', luB) -> Just (zip a' b', max luA luB)
|
||||
(Nothing, Just (b', luB)) -> do -- | luB /= NeverInput -> do
|
||||
r <- getTokenValueRaw Never a
|
||||
pure $ case r of
|
||||
Nothing -> error "unexpected"
|
||||
Just (a', luA) -> Just (zip a' b', max luA luB)
|
||||
_ ->
|
||||
pure $ Nothing
|
||||
|
||||
ListToken ts -> do
|
||||
ms <- mapM (getTokenValueRaw luFuture) ts
|
||||
if False -- null $ filter ((/= NeverInput) . snd) (catMaybes ms)
|
||||
then pure Nothing
|
||||
else do ms' <- case sequence ms of
|
||||
Just x -> pure x
|
||||
Nothing -> do r <- mapM (getTokenValueRaw Never) ts
|
||||
case sequence r of
|
||||
Nothing -> error "unexpected"
|
||||
Just x -> pure x
|
||||
let (as, lus) = unzip ms'
|
||||
pure $ Just (as, maximumOrNever lus)
|
||||
|
||||
NoToken ->
|
||||
pure $ Just ((), Never)
|
||||
|
||||
getTokenValue :: Token a -> LastUpdated -> DepRunM (Maybe (Value, LastUpdated))
|
||||
getTokenValue token luFuture = case token of
|
||||
Token i ->
|
||||
getTokenValueByIndex i
|
||||
getTokenValueByIndex luFuture i
|
||||
TupleToken _ _ ->
|
||||
fromRaw token
|
||||
ZipToken _ _ ->
|
||||
|
|
@ -80,26 +166,70 @@ getTokenValue token = case token of
|
|||
fromRaw token
|
||||
NoToken ->
|
||||
fromRaw token
|
||||
where fromRaw :: (Typeable a, Show a) => Token a -> DepRunM Value
|
||||
fromRaw = fmap toValue . getTokenValueRaw
|
||||
where fromRaw :: (Typeable a, Show a) => Token a -> DepRunM (Maybe (Value, LastUpdated))
|
||||
fromRaw t = do
|
||||
m <- getTokenValueRaw luFuture t
|
||||
pure $ do (x, lu) <- m
|
||||
pure (toValue x, lu)
|
||||
|
||||
putTokenValue :: Token a -> ValueExistence -> DepRunM ()
|
||||
putTokenValue t e = case t of
|
||||
putTokenValue t v = case t of
|
||||
Token i ->
|
||||
modify $ M.insert i e
|
||||
modify $ M.insert i v
|
||||
NoToken ->
|
||||
pure ()
|
||||
_ ->
|
||||
error "unexpected"
|
||||
|
||||
runAction :: forall a b. Action a b -> Value -> DepRunM Value
|
||||
runAction action input = case action of
|
||||
maximumModTime :: [FilePath] -> DepRunM LastUpdated
|
||||
maximumModTime paths = do
|
||||
paths' <- filterM (liftIO . SD.doesPathExist) paths
|
||||
times <- mapM (liftIO . getModificationTime) paths'
|
||||
pure $ maximumOrNever' times
|
||||
|
||||
runAction :: forall a b. Action a b -> Token a -> LastUpdated
|
||||
-> DepRunM (Maybe (Value, LastUpdated))
|
||||
runAction action tokenInput luFuture = case action of
|
||||
Function (F f) ->
|
||||
calc f
|
||||
FunctionIO f ->
|
||||
calcM (liftIO . evalFunctionIO f)
|
||||
FunctionIO f -> do
|
||||
m <- getTokenValueRaw luFuture $ functionIOWrites f tokenInput
|
||||
case m of
|
||||
Nothing ->
|
||||
pure Nothing -- error "unexpected" -- wrong?
|
||||
Just (writes, _writesLu) -> do
|
||||
tell writes
|
||||
lastWritten <- max luFuture <$> maximumModTime writes
|
||||
result <- getTokenValue tokenInput lastWritten
|
||||
case result of
|
||||
Just (inputValue, luInput) -> do
|
||||
let input = inputFromValue inputValue
|
||||
lastUpdated <- max luInput <$> (maximumModTime $ functionIOReads f input)
|
||||
if lastUpdated > lastWritten
|
||||
then do liftIO $ do
|
||||
putStrLn ("input: " ++ show input)
|
||||
putStrLn ("input last updated: " ++ show luInput)
|
||||
putStrLn ("IO function: " ++ show f)
|
||||
putStrLn ("Source timestamp: " ++ show lastUpdated)
|
||||
putStrLn ("Target timestamp: " ++ show lastWritten)
|
||||
v <- toValue <$> (liftIO $ evalFunctionIO f input)
|
||||
-- tell writes
|
||||
let luResult = max luInput lastUpdated
|
||||
liftIO $ do
|
||||
putStrLn ("output: " ++ show v)
|
||||
putStrLn ("output last updated: " ++ show luResult)
|
||||
putStrLn "----------"
|
||||
pure $ Just (v, luResult)
|
||||
else do -- liftIO $ putStrLn ("Source timestamp "
|
||||
-- ++ show lastUpdated
|
||||
-- ++ " not newer than target timestamp "
|
||||
-- ++ show lastWritten
|
||||
-- ++ "; ignoring IO computation.")
|
||||
pure Nothing -- (toValue (), lastWritten) -- assumes writing FunctionIO always return ()
|
||||
Nothing ->
|
||||
pure Nothing
|
||||
Inject x ->
|
||||
pure $ toValue x
|
||||
pure $ Just (toValue x, NeverInput)
|
||||
FilterComp ->
|
||||
calc (\(vs, mask) -> map fst $ filter snd $ zip vs mask)
|
||||
UntupleFst ->
|
||||
|
|
@ -110,14 +240,28 @@ runAction action input = case action of
|
|||
calc (map fst)
|
||||
UnzipSnd ->
|
||||
calc (map snd)
|
||||
MapComp subDeps innerInput innerOutput ->
|
||||
(toValueRep (actionTargetType action) <$>)
|
||||
$ forM (fromValueRep (actionSourceType action) input) $ \x -> do
|
||||
putTokenValue innerInput $ Evaluated $ toValue x
|
||||
runDeps subDeps
|
||||
fromValue <$> getTokenValue innerOutput
|
||||
where calcM :: (Typeable a, Typeable b, Show b) => (a -> DepRunM b) -> DepRunM Value
|
||||
calcM f = toValue <$> (f $ fromValueRep (actionSourceType action) input)
|
||||
MapComp subDeps innerInput innerOutput -> do
|
||||
m <- getTokenValue tokenInput luFuture
|
||||
case m of
|
||||
Nothing -> pure Nothing
|
||||
Just (inputValue, luInput) -> do
|
||||
let input = inputFromValue inputValue
|
||||
lastUpdated <- maximumModTime $ actionReads action input
|
||||
result <- forM input $ \x -> do
|
||||
putTokenValue innerInput $ Evaluated (toValue x) (max luInput lastUpdated)
|
||||
runDeps subDeps
|
||||
m <- getTokenValue innerOutput luFuture
|
||||
pure $ do (vOut, luOut) <- m
|
||||
pure (fromValue vOut, luOut)
|
||||
pure $ do result' <- sequence result
|
||||
let (values, lus) = unzip result'
|
||||
pure $ (toValueRep (actionTargetType action) values, maximumOrNever lus)
|
||||
where inputFromValue :: Typeable a => Value -> a
|
||||
inputFromValue = fromValueRep (actionSourceType action)
|
||||
|
||||
calc :: (Typeable a, Typeable b, Show b) => (a -> b) -> DepRunM Value
|
||||
calc f = calcM (pure . f)
|
||||
calc :: (Typeable a, Typeable b, Show b) => (a -> b) -> DepRunM (Maybe (Value, LastUpdated))
|
||||
calc f = do
|
||||
m <- getTokenValue tokenInput luFuture
|
||||
pure $ do (inputValue, luInput) <- m
|
||||
let input = inputFromValue inputValue
|
||||
pure (toValue $ f input, luInput)
|
||||
|
|
|
|||
|
|
@ -6,9 +6,10 @@ module Functions.Image
|
|||
, convertImage
|
||||
) where
|
||||
|
||||
import Types (IsFunctionIO(..), Token)
|
||||
import Types (IsFunctionIO(..), Token(..))
|
||||
import DependencyGenerator (DepGenM, TokenableTo(..), onTupleToken, toTupleToken,
|
||||
runFunctionIO, runFunctionIO_)
|
||||
import DependencyRunner (extractSndTokenAsList)
|
||||
|
||||
import qualified Codec.Picture as CP
|
||||
import qualified Codec.Picture.STBIR as CPS
|
||||
|
|
@ -31,7 +32,7 @@ instance IsFunctionIO OpenImage FilePath Image where
|
|||
Left e -> error ("unexpected error: " ++ e)
|
||||
Right image -> pure $ ImageWrapper $ CP.convertRGB8 image
|
||||
functionIOReads OpenImage s = [s]
|
||||
functionIOWrites OpenImage = const []
|
||||
functionIOWrites OpenImage = const (ListToken [])
|
||||
functionIOWritesAny OpenImage = False
|
||||
|
||||
openImage :: TokenableTo FilePath a => a -> DepGenM (Token Image)
|
||||
|
|
@ -43,7 +44,7 @@ instance IsFunctionIO SaveImage (Image, FilePath) () where
|
|||
evalFunctionIO SaveImage (ImageWrapper image, s) =
|
||||
CP.saveJpgImage 90 s $ CP.ImageRGB8 image
|
||||
functionIOReads SaveImage = const []
|
||||
functionIOWrites SaveImage (_, s) = [s]
|
||||
functionIOWrites SaveImage = extractSndTokenAsList
|
||||
functionIOWritesAny SaveImage = True
|
||||
|
||||
saveImage :: (TokenableTo Image a, TokenableTo FilePath b) => a -> b -> DepGenM ()
|
||||
|
|
|
|||
|
|
@ -12,8 +12,10 @@ module Functions.Paths
|
|||
import Types (IsFunctionIO(..), Token(..))
|
||||
import DependencyGenerator (DepGenM, TokenableTo(..), onToken, onTupleToken, toTupleToken,
|
||||
runFunctionIO, runFunctionIO_, untupleSndDepGenM)
|
||||
import DependencyRunner (extractSndTokenAsList)
|
||||
|
||||
import Data.Char (toLower)
|
||||
import Control.Monad (when)
|
||||
import qualified System.Directory as SD
|
||||
|
||||
joinPaths :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM (Token FilePath)
|
||||
|
|
@ -37,8 +39,8 @@ data ListDirectory = ListDirectory deriving Show
|
|||
instance IsFunctionIO ListDirectory FilePath [FilePath] where
|
||||
evalFunctionIO ListDirectory s = SD.listDirectory s
|
||||
functionIOReads ListDirectory s = [s]
|
||||
functionIOWrites ListDirectory = const []
|
||||
functionIOWritesAny ListDirectory = False
|
||||
functionIOWrites ListDirectory = const (ListToken [])
|
||||
functionIOWritesAny ListDirectory = False -- old: force triggering
|
||||
|
||||
listDirectory :: TokenableTo FilePath a => a -> DepGenM (Token [FilePath])
|
||||
listDirectory a = runFunctionIO ListDirectory =<< toToken a
|
||||
|
|
@ -48,7 +50,7 @@ data IsDirectory = IsDirectory deriving Show
|
|||
instance IsFunctionIO IsDirectory FilePath Bool where
|
||||
evalFunctionIO IsDirectory s = SD.doesDirectoryExist s
|
||||
functionIOReads IsDirectory s = [s]
|
||||
functionIOWrites IsDirectory = const []
|
||||
functionIOWrites IsDirectory = const (ListToken [])
|
||||
functionIOWritesAny IsDirectory = False
|
||||
|
||||
isDirectory :: TokenableTo FilePath a => a -> DepGenM (Token Bool)
|
||||
|
|
@ -57,10 +59,17 @@ isDirectory a = runFunctionIO IsDirectory =<< toToken a
|
|||
|
||||
data MakeDir = MakeDir deriving Show
|
||||
instance IsFunctionIO MakeDir FilePath () where
|
||||
evalFunctionIO MakeDir s =
|
||||
SD.createDirectory s
|
||||
evalFunctionIO MakeDir s = do
|
||||
exists <- SD.doesPathExist s
|
||||
when (not exists) $ SD.createDirectory s
|
||||
functionIOReads MakeDir = const []
|
||||
functionIOWrites MakeDir s = [s]
|
||||
functionIOWrites MakeDir s = ListToken [s]
|
||||
|
||||
|
||||
-- Old: Don't consider a created
|
||||
-- directory "written", as there is
|
||||
-- no extra information than its name
|
||||
-- and presence.
|
||||
functionIOWritesAny MakeDir = True
|
||||
|
||||
makeDir :: TokenableTo FilePath a => a -> DepGenM ()
|
||||
|
|
@ -72,7 +81,7 @@ instance IsFunctionIO CopyFile (FilePath, FilePath) () where
|
|||
evalFunctionIO CopyFile (source, target) =
|
||||
SD.copyFile source target
|
||||
functionIOReads CopyFile (i, _) = [i]
|
||||
functionIOWrites CopyFile (_, o) = [o]
|
||||
functionIOWrites CopyFile = extractSndTokenAsList
|
||||
functionIOWritesAny CopyFile = True
|
||||
|
||||
copyFile :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM ()
|
||||
|
|
|
|||
|
|
@ -3,9 +3,10 @@ module Functions.Text
|
|||
, saveTextFile
|
||||
) where
|
||||
|
||||
import Types (IsFunctionIO(..), Token)
|
||||
import Types (IsFunctionIO(..), Token(..))
|
||||
import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken,
|
||||
runFunctionIO, runFunctionIO_)
|
||||
import DependencyRunner (extractSndTokenAsList)
|
||||
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text.IO as T
|
||||
|
|
@ -14,7 +15,7 @@ data ReadTextFile = ReadTextFile deriving Show
|
|||
instance IsFunctionIO ReadTextFile FilePath Text where
|
||||
evalFunctionIO ReadTextFile s = T.readFile s
|
||||
functionIOReads ReadTextFile s = [s]
|
||||
functionIOWrites ReadTextFile = const []
|
||||
functionIOWrites ReadTextFile = const (ListToken [])
|
||||
functionIOWritesAny ReadTextFile = False
|
||||
|
||||
readTextFile :: TokenableTo FilePath a => a -> DepGenM (Token Text)
|
||||
|
|
@ -25,7 +26,7 @@ data SaveTextFile = SaveTextFile deriving Show
|
|||
instance IsFunctionIO SaveTextFile (Text, FilePath) () where
|
||||
evalFunctionIO SaveTextFile (t, s) = T.writeFile s t
|
||||
functionIOReads SaveTextFile = const []
|
||||
functionIOWrites SaveTextFile (_, s) = [s]
|
||||
functionIOWrites SaveTextFile = extractSndTokenAsList
|
||||
functionIOWritesAny SaveTextFile = True
|
||||
|
||||
saveTextFile :: (TokenableTo Text a, TokenableTo FilePath b) => a -> b -> DepGenM ()
|
||||
|
|
|
|||
|
|
@ -16,8 +16,9 @@ main :: IO ()
|
|||
main = do
|
||||
args <- getArgs
|
||||
case args of
|
||||
["run"] ->
|
||||
DR.runDepRunMIO $ DR.runDeps dependencies
|
||||
["run"] -> do
|
||||
((), filesWritten) <- DR.runDepRunMIO $ DR.runDeps dependencies
|
||||
putStrLn ("Files which could have been written: " ++ show filesWritten)
|
||||
["tree"] ->
|
||||
T.putStr $ D.formatDependencyTrees dependencies
|
||||
_ ->
|
||||
|
|
|
|||
|
|
@ -56,10 +56,10 @@ actionReads = \case
|
|||
FunctionIO f -> functionIOReads f
|
||||
_ -> const []
|
||||
|
||||
actionWrites :: Action a b -> a -> [FilePath]
|
||||
actionWrites :: Action a b -> Token a -> Token [FilePath]
|
||||
actionWrites = \case
|
||||
FunctionIO f -> functionIOWrites f
|
||||
_ -> const []
|
||||
_ -> const (ListToken [])
|
||||
|
||||
actionWritesAny :: Action a b -> Bool
|
||||
actionWritesAny = \case
|
||||
|
|
|
|||
|
|
@ -3,10 +3,11 @@ module Types.Functions
|
|||
( IsFunctionIO(..)
|
||||
) where
|
||||
|
||||
import Types.Token (Token)
|
||||
import Type.Reflection (Typeable)
|
||||
|
||||
class (Show f, Show a, Typeable a, Show b, Typeable b) => IsFunctionIO f a b | f -> a b where
|
||||
evalFunctionIO :: f -> a -> IO b
|
||||
functionIOReads :: f -> a -> [FilePath]
|
||||
functionIOWritesAny :: f -> Bool
|
||||
functionIOWrites :: f -> a -> [FilePath]
|
||||
functionIOWrites :: f -> Token a -> Token [FilePath]
|
||||
|
|
|
|||
2
om.md
2
om.md
|
|
@ -25,7 +25,7 @@ Klik på [Feed](/atom.xml)-fanen i toppen af siden for at tilgå et Atom-feed me
|
|||
|
||||
## Licens
|
||||
|
||||
<p xmlns:cc="http://creativecommons.org/ns#" xmlns:dct="http://purl.org/dc/terms/"><span property="dct:title">Niels' mad</span> by <span property="cc:attributionName">Niels G. W. Serup</span> er licenseret under <a href="https://creativecommons.org/licenses/by-sa/4.0/?ref=chooser-v1" target="_blank" rel="license noopener noreferrer" style="display:inline-block;">CC BY-SA 4.0<img style="height:22px!important;margin-left:3px;vertical-align:text-bottom;" src="https://mirrors.creativecommons.org/presskit/icons/cc.svg?ref=chooser-v1" alt=""><img style="height:22px!important;margin-left:3px;vertical-align:text-bottom;" src="https://mirrors.creativecommons.org/presskit/icons/by.svg?ref=chooser-v1" alt=""><img style="height:22px!important;margin-left:3px;vertical-align:text-bottom;" src="https://mirrors.creativecommons.org/presskit/icons/sa.svg?ref=chooser-v1" alt=""></a></p>
|
||||
<p xmlns:cc="http://creativecommons.org/ns#" xmlns:dct="http://purl.org/dc/terms/"><span property="dct:title">Niels' mad</span> af <span property="cc:attributionName">Niels G. W. Serup</span> er licenseret under <a href="https://creativecommons.org/licenses/by-sa/4.0/?ref=chooser-v1" target="_blank" rel="license noopener noreferrer" style="display:inline-block;">CC BY-SA 4.0<img style="height:22px!important;margin-left:3px;vertical-align:text-bottom;" src="https://mirrors.creativecommons.org/presskit/icons/cc.svg?ref=chooser-v1" alt=""><img style="height:22px!important;margin-left:3px;vertical-align:text-bottom;" src="https://mirrors.creativecommons.org/presskit/icons/by.svg?ref=chooser-v1" alt=""><img style="height:22px!important;margin-left:3px;vertical-align:text-bottom;" src="https://mirrors.creativecommons.org/presskit/icons/sa.svg?ref=chooser-v1" alt=""></a></p>
|
||||
|
||||
|
||||
## Hjemmesidegenerator
|
||||
|
|
|
|||
Loading…
Reference in New Issue