git.iko.soy/typeable/pandoc
on 7701a87 help sign in
typeable/pandoc/Setup.hs
95 lines 4.3 kB history raw
1import Distribution.Simple
2import Distribution.Simple.Setup
3import Distribution.PackageDescription
4import Distribution.Simple.LocalBuildInfo
5import System.FilePath (combine, joinPath, takeFileName, takeExtension)
6import System.Directory (getDirectoryContents, removeFile, copyFile)
7import System.IO (readFile, writeFile)
8import Control.Monad (foldM)
9import Data.List (isPrefixOf)
11main = defaultMainWithHooks myHooks
13myHooks = defaultUserHooks { postConf = myPostConf, postClean = myPostClean }
15pandocPath = combine "Text" "Pandoc"
17-- Builds Text/Pandoc/ASCIIMathML.hs, Text/Pandoc/Writers/S5.hs, and
18-- Text/Pandoc/Writers/DefaultHeaders.hs from templates and data.
19myPostConf :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()
20myPostConf _ configFlags pkgDescription buildInfo = do
21 putStrLn "Generating source files from templates..."
22 fillAsciiMathMLTemplate
23 fillS5WriterTemplate
24 fillDefaultHeadersTemplate
25 let deps = packageDeps buildInfo
26 let highlighting = any (\id -> pkgName id == "highlighting-kate") deps
27 let highlightingModule = if highlighting
28 then combine "templates" "Highlighting.yes.hs"
29 else combine "templates" "Highlighting.no.hs"
30 copyFile highlightingModule $ joinPath ["Text", "Pandoc", "Highlighting.hs"]
31 putStrLn $ " Text/Pandoc/Highlighting.hs [" ++
32 (if highlighting then "with" else "without") ++ " syntax highlighting support]"
34-- Fill templateFile with data in dataFiles and write to outputFile.
35fillTemplate :: [FilePath] -> FilePath -> FilePath -> IO ()
36fillTemplate dataFiles templateFile outputFile = do
37 template <- readFile (combine "templates" templateFile)
38 filled <- foldM processFile template $ map (combine "templates") dataFiles
39 writeTemplate (combine pandocPath outputFile) filled
41fillAsciiMathMLTemplate :: IO ()
42fillAsciiMathMLTemplate =
43 fillTemplate ["ASCIIMathML.js.comment", "ASCIIMathML.js.packed"] "ASCIIMathML.hs" "ASCIIMathML.hs"
45fillS5WriterTemplate :: IO ()
46fillS5WriterTemplate =
47 let s5Path = joinPath ["ui", "default"]
48 files = map (combine s5Path) ["slides.js.comment", "slides.js.packed", "s5-core.css",
49 "framing.css", "pretty.css", "opera.css", "outline.css", "print.css"]
50 in fillTemplate files "S5.hs" (combine "Writers" "S5.hs")
52fillDefaultHeadersTemplate :: IO ()
53fillDefaultHeadersTemplate = do
54 files <- getDirectoryContents (combine "templates" "headers") >>=
55 return . map (combine "headers") . filter (\x -> takeExtension x == ".header")
56 fillTemplate files "DefaultHeaders.hs" "DefaultHeaders.hs"
58-- Post-clean: remove the files generated from templates.
59myPostClean :: Args -> CleanFlags -> PackageDescription -> Maybe LocalBuildInfo -> IO ()
60myPostClean _ _ _ _ = do
61 putStrLn "Removing source files generated from templates:"
62 removeGeneratedFile $ joinPath [pandocPath, "ASCIIMathML.hs"]
63 removeGeneratedFile $ joinPath [pandocPath, "DefaultHeaders.hs"]
64 removeGeneratedFile $ joinPath [pandocPath, "Highlighting.hs"]
65 removeGeneratedFile $ joinPath [pandocPath, "Writers", "S5.hs"]
67-- Remove file and print message.
68removeGeneratedFile :: FilePath -> IO ()
69removeGeneratedFile fpath = do
70 putStrLn $ " " ++ fpath
71 removeFile fpath
73-- Write the filled template file and print an explanatory message.
74writeTemplate :: FilePath -> String -> IO ()
75writeTemplate outfile contents = do
76 putStrLn $ " " ++ outfile
77 let warning = "-- This file is generated from a template in the templates subdirectory.\n\
78 \-- Modify that file, not this one.\n"
79 writeFile outfile (warning ++ contents)
81-- Read contents of fpath and insert in template replacing @fpath@.
82processFile :: String -> FilePath -> IO String
83processFile template fpath = do
84 contents <- readFile fpath >>= return . show
85 return $ substitute ("@" ++ takeFileName fpath ++ "@") contents template
87-- Replace each occurrence of one sublist in a list with another.
88substitute :: (Eq a) => [a] -> [a] -> [a] -> [a]
89substitute _ _ [] = []
90substitute [] _ lst = lst
91substitute target replacement lst =
92 if target `isPrefixOf` lst
93 then replacement ++ (substitute target replacement $ drop (length target) lst)
94 else (head lst):(substitute target replacement $ tail lst)