-
Notifications
You must be signed in to change notification settings - Fork 0
/
Hyde.hs
61 lines (46 loc) · 1.52 KB
/
Hyde.hs
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
module Main where
import System.IO
import System.Directory
import Maybe
import Data.List
import Data.Char
import System.Process
import Control.Monad
import Control.Concurrent
import qualified FSWatcher as FSW
-- Configuration
dirIn = "Site"
dirGlobal = "Global"
dirOut = "out"
suffixIn = ".hs"
suffixOut = ".html"
-- Compilation
stripSuffix suffix xs = do
xs' <- stripPrefix (reverse suffix) (reverse xs)
return $ reverse xs'
compile :: FSW.Difference -> IO ()
compile diff = do
let infiles = filter (isSuffixOf suffixIn) (FSW.new diff ++ FSW.modified diff)
let outfiles = map ((dirOut ++) . (map toLower) . fromJust . (stripPrefix dirIn) .
(++ suffixOut) . fromJust . (stripSuffix suffixIn)) infiles
putStr "Generating markup..."
hFlush stdout
out <- mapM (\f -> readProcessWithExitCode "runhaskell" [f] "") infiles
let (success, error) = partition (\(_, (_, _, e)) -> null e) (zip outfiles out)
case error of
[] -> putStrLn " done"
_ -> putStrLn " encountered errors:"
-- print errors
when (not . null $ error) $ putStrLn $ concat $ map (\(_, (_, _, e)) -> e) error
-- write generated output
when (not . null $ success) $ mapM_ (\(f, (_, o, _)) -> writeFile f o) success
compileAll :: FSW.Difference -> IO ()
compileAll _ = do
files <- FSW.getTimestamps dirIn
compile $ FSW.Difference (map FSW.filepath files) [] []
main = do
createDirectoryIfMissing True dirIn
createDirectoryIfMissing True dirGlobal
createDirectoryIfMissing True dirOut
forkIO $ FSW.poll False dirGlobal compileAll
FSW.poll True dirIn compile