git.iko.soy/typeable/hexml
on master help sign in
typeable/hexml/gen/Main.hs
70 lines 2.3 kB history raw
2module Main(main) where
4import Lib
5import Parser
6import Control.Monad.Extra
7import System.Process.Extra
8import System.Directory
9import Data.Maybe
10import System.IO.Extra
11import System.FilePath
12import System.Info.Extra
15main :: IO ()
16main = do
17 forM_ examples $ \(b, src) -> do
18 putStrLn ""
19 putStrLn src
20 let (res, trail, err) = run html src
21 print res
22 print (trail, err)
23 putStrLn $ rerender src res
24 writeFileChanged "test.h" $ unlines $ compile html
25 buildRule ["test.h","test.c"] ["gen" <.> (if isWindows then "exe" else "")] $
26 system_ "gcc test.c -o gen -Werror -Wall -Wextra -DTEST"
27 system_ "gen"
29writeFileChanged :: FilePath -> String -> IO ()
30writeFileChanged file new = do
31 old <- ifM (doesFileExist file) (readFile' file) (pure "")
32 when (old /= new) $
33 writeFile file new
35buildRule :: [FilePath] -> [FilePath] -> IO () -> IO ()
36buildRule from to act = do
37 let modTime x = ifM (doesFileExist x) (Just <$> getModificationTime x) (pure Nothing)
38 from <- mapM modTime from
39 to <- mapM modTime to
40 when (any isNothing (from ++ to) || maximum from >= minimum to)
41 act
43examples :: [(Bool, String)]
44examples = take 1
45 [(True, "<test foo='123 xyz'><inner /> value</test>")
46 ,(True, "<test />")
47 ,(True, "<test id='bob'>here<extra/>there</test>")
48 ,(True, "<test /><close />")
49 ,(True, "<test /><!-- comment > --><close />")
50 ,(True, "<test id=\"bob value\" another-attr=\"test with <\">here </test> more text at the end<close />")
51 ,(False, "<test></more>")
52 ,(False, "<test")
53 ,(True, "<?xml version=\"1.1\"?>\n<greeting>Hello, world!</greeting>")
54 ]
56rerender :: String -> [(Int, Out)] -> String
57rerender o = f
58 where
59 sub s e = take (e - s) $ drop s o
61 f ((_,Tag):(_,TagComment):xs) = f xs
62 f ((_,Tag):xs) = "<" ++ f xs
63 f ((_,TagOpen):xs) = ">" ++ f xs
64 f ((_,TagOpenClose):xs) = "/>" ++ f xs
65 f ((s,NameStart):(e,NameEnd):(_,TagClose):xs) = "/" ++ sub s e ++ ">" ++ f xs
66 f ((s,NameStart):(e,NameEnd):xs) = sub s e ++ " " ++ f xs
67 f ((s,QuoteStart):(e,QuoteEnd):xs) = "=\"" ++ sub s e ++ "\" " ++ f xs
68 f ((_,AttribsStart):xs) = f xs
69 f ((_,AttribsEnd):xs) = f xs
70 f [] = []