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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
{-# LANGUAGE Arrows #-}
import Data.Binary (encode)
import Data.List (intercalate, isInfixOf, sortOn)
import qualified Data.Text as Text
import Skylighting.Loader (loadSyntaxesFromDir)
import Skylighting.Parser (missingIncludes)
import Skylighting.Types
import System.Directory
import System.Environment (getArgs)
import System.Exit
import System.IO (hPutStrLn, stderr)
import System.FilePath
import qualified Data.Map as M
main :: IO ()
main = do
createDirectoryIfMissing True $ "src" </> "Skylighting" </> "Syntax"
files <- getArgs
res <- case files of
[] -> return $ Left "No directory specified"
[d] -> loadSyntaxesFromDir d
_ -> return $ Left "Too many directories specified"
case res of
Left err -> hPutStrLn stderr err >> exitWith (ExitFailure 1)
Right sm -> do
let syntaxes = sortOn sShortname $ M.elems sm
mapM_ writeModuleFor syntaxes
case missingIncludes syntaxes of
[] -> return ()
ns -> do
mapM_ (\(syn,dep) -> hPutStrLn stderr
("Missing syntax definition: " ++ Text.unpack syn ++
" requires " ++
Text.unpack dep ++ " through IncludeRules.")) ns
hPutStrLn stderr "Fatal error."
exitWith (ExitFailure 1)
putStrLn "Backing up skylighting.cabal to skylighting.cabal.orig"
copyFile "skylighting.cabal" "skylighting.cabal.orig"
putStrLn "Updating module list in skylighting.cabal"
cabalLines <- lines <$> readFile "skylighting.cabal.orig"
let (top, rest) = break ("other-modules:" `isInfixOf`) cabalLines
let (_, bottom) = span ("Skylighting.Syntax." `isInfixOf`) (drop 1 rest)
let modulenames = map (\s -> "Skylighting.Syntax." ++
Text.unpack (sShortname s)) syntaxes
let autogens = map ((replicate 23 ' ') ++) modulenames
let newcabal = unlines $ top ++ (" other-modules:" : autogens) ++
bottom
writeFile "skylighting.cabal" newcabal
let ssyn = "src" </> "Skylighting" </> "Syntax.hs"
putStrLn $ "Writing " ++ ssyn
writeFile ssyn $ unlines (
[ "{-# LANGUAGE OverloadedStrings #-}"
, "-- | Provides syntax highlighting definitions."
, "-- THIS FILE IS AUTOMATICALLY GENERATED. DO NOT EDIT IT MANUALLY."
, "module Skylighting.Syntax (defaultSyntaxMap) where"
, "import qualified Data.Map as Map"
, "import Skylighting.Types" ] ++
[ "import qualified " ++ m | m <- modulenames ]
++
[ ""
, "-- | Default mapping from short names to syntax definitions."
, "defaultSyntaxMap :: SyntaxMap"
, "defaultSyntaxMap = Map.fromList ["
]) ++ " " ++
(intercalate "\n ,"
[" (" ++ show (Text.unpack $ sName s) ++ ", "
++ "Skylighting.Syntax." ++ Text.unpack (sShortname s) ++
".syntax)"
| s <- syntaxes ]) ++ " ]"
writeModuleFor :: Syntax -> IO ()
writeModuleFor syn = do
let fp = toPathName syn
putStrLn $ "Writing " ++ fp
writeFile fp $ unlines $
[ "{-# LANGUAGE OverloadedStrings #-}"
, "-- | Automatically generated syntax definition for " ++
Text.unpack (sName syn) ++ "."
, "-- DO NOT EDIT THIS FILE MANUALLY."
, "-- Instead, modify xml/" ++ sFilename syn ++ " and 'make bootstrap'."
, "module Skylighting.Syntax." ++ Text.unpack (sShortname syn) ++
" (syntax) where"
, ""
, "import Skylighting.Types"
, "import Data.Binary"
, ""
, "-- | Syntax definition for " ++ Text.unpack (sName syn) ++ "."
, "syntax :: Syntax"
, "syntax = decode " ++ show (encode syn) ]
-- NOTE: we include string representation of the Syntax,
-- which we then 'decode', rather than the code for the Syntax,
-- because ghc doesn't deal well with large data structure
-- literals. For background see jgm/skylighting#7 and
-- http://stackoverflow.com/questions/16348340/compiling-very-large-constants-with-ghc
toPathName :: Syntax -> String
toPathName s =
"src" </> "Skylighting" </> "Syntax" </>
map (\c -> if c == '.' then pathSeparator else c)
(Text.unpack (sShortname s)) ++ ".hs"
|
