git.iko.soy/typeable/pandoc
on 2284608 help sign in
typeable/pandoc/Setup.hs
70 lines 3.1 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 $ simpleUserHooks { postConf = myPostConf }
13pandocPath = combine "Text" "Pandoc"
15-- Builds Text/Pandoc/ASCIIMathML.hs, Text/Pandoc/Writers/S5.hs, and
16-- Text/Pandoc/Writers/DefaultHeaders.hs from templates and data.
17myPostConf :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()
18myPostConf _ configFlags pkgDescription buildInfo = do
19 putStrLn "Generating source files from templates..."
20 fillAsciiMathMLTemplate
21 fillS5WriterTemplate
22 fillDefaultHeadersTemplate
24-- Fill templateFile with data in dataFiles and write to outputFile.
25fillTemplate :: [FilePath] -> FilePath -> FilePath -> IO ()
26fillTemplate dataFiles templateFile outputFile = do
27 template <- readFile (combine "templates" templateFile)
28 filled <- foldM processFile template $ map (combine "templates") dataFiles
29 writeTemplate (combine pandocPath outputFile) filled
31fillAsciiMathMLTemplate :: IO ()
32fillAsciiMathMLTemplate =
33 fillTemplate ["ASCIIMathML.js.comment", "ASCIIMathML.js.packed"] "ASCIIMathML.hs" "ASCIIMathML.hs"
35fillS5WriterTemplate :: IO ()
36fillS5WriterTemplate =
37 let s5Path = joinPath ["ui", "default"]
38 files = map (combine s5Path) ["slides.js.comment", "slides.js.packed", "s5-core.css",
39 "framing.css", "pretty.css", "opera.css", "outline.css", "print.css"]
40 in fillTemplate files "S5.hs" (combine "Writers" "S5.hs")
42fillDefaultHeadersTemplate :: IO ()
43fillDefaultHeadersTemplate = do
44 files <- getDirectoryContents (combine "templates" "headers") >>=
45 return . map (combine "headers") . filter (\x -> takeExtension x == ".header")
46 fillTemplate files "DefaultHeaders.hs" "DefaultHeaders.hs"
48-- Write the filled template file and print an explanatory message.
49writeTemplate :: FilePath -> String -> IO ()
50writeTemplate outfile contents = do
51 putStrLn $ " " ++ outfile
52 let warning = "-- This file is generated from a template in the templates subdirectory.\n\
53 \-- Modify that file, not this one.\n"
54 writeFile outfile (warning ++ contents)
56-- Read contents of fpath and insert in template replacing @fpath@.
57processFile :: String -> FilePath -> IO String
58processFile template fpath = do
59 contents <- readFile fpath >>= return . show
60 return $ substitute ("@" ++ takeFileName fpath ++ "@") contents template
62-- Replace each occurrence of one sublist in a list with another.
63substitute :: (Eq a) => [a] -> [a] -> [a] -> [a]
64substitute _ _ [] = []
65substitute [] _ lst = lst
66substitute target replacement lst =
67 if target `isPrefixOf` lst
68 then replacement ++ (substitute target replacement $ drop (length target) lst)
69 else (head lst):(substitute target replacement $ tail lst)