1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
-- | These are the additional rule types required by Makefile
module Development.Make.Rules(
need_, want_,
defaultRuleFile_,
(??>), Phony(..)
) where
import Control.Monad.IO.Class
import System.Directory
import Development.Shake.Core
import General.String
import Development.Shake.Classes
import Development.Shake.FilePath
import Development.Shake.FileInfo
infix 1 ??>
---------------------------------------------------------------------
-- FILE_ RULES
-- These are like file rules, but a rule may not bother creating the result
-- Which matches the (insane) semantics of make
-- If a file is not produced, it will rebuild forever
newtype File_Q = File_Q BSU
deriving (Typeable,Eq,Hashable,Binary,NFData)
instance Show File_Q where show (File_Q x) = unpackU x
newtype File_A = File_A (Maybe ModTime)
deriving (Typeable,Eq,Hashable,Binary,Show,NFData)
instance Rule File_Q File_A where
storedValue _ (File_Q x) = fmap (fmap (File_A . Just . fst)) $ getFileInfo x
defaultRuleFile_ :: Rules ()
defaultRuleFile_ = priority 0 $ rule $ \(File_Q x) -> Just $ liftIO $ do
res <- getFileInfo x
case res of
Nothing -> error $ "Error, file does not exist and no rule available:\n " ++ unpackU x
Just (mt,_) -> return $ File_A $ Just mt
need_ :: [FilePath] -> Action ()
need_ xs = (apply $ map (File_Q . packU) xs :: Action [File_A]) >> return ()
want_ :: [FilePath] -> Rules ()
want_ = action . need_
data Phony = Phony | NotPhony deriving Eq
(??>) :: (FilePath -> Bool) -> (FilePath -> Action Phony) -> Rules ()
(??>) test act = rule $ \(File_Q x_) -> let x = unpackU x_ in
if not $ test x then Nothing else Just $ do
liftIO $ createDirectoryIfMissing True $ takeDirectory x
res <- act x
liftIO $ fmap (File_A . fmap fst) $ if res == Phony
then return Nothing
else getFileInfo x_
|
