mirror of
https://github.com/GaloisInc/cryptol.git
synced 2024-12-24 00:12:22 +03:00
65 lines
1.8 KiB
Haskell
65 lines
1.8 KiB
Haskell
|
#!/usr/bin/env runhaskell
|
||
|
|
||
|
-- |
|
||
|
-- Module : $Header$
|
||
|
-- Copyright : (c) 2013-2014 Galois, Inc.
|
||
|
-- License : BSD3
|
||
|
-- Maintainer : cryptol@galois.com
|
||
|
-- Stability : provisional
|
||
|
-- Portability : portable
|
||
|
|
||
|
import Cryptol.Parser.Lexer
|
||
|
import Cryptol.Utils.PP
|
||
|
|
||
|
main :: IO ()
|
||
|
main = interact (wrap . concat . map toHTML . fst . primLexer defaultConfig)
|
||
|
|
||
|
wrap :: String -> String
|
||
|
wrap txt = "<html><head>" ++ sty ++ "</head><body>" ++ txt ++ "</body>"
|
||
|
|
||
|
toHTML :: Located Token -> String
|
||
|
toHTML tok = "<span class=\"" ++ cl ++ "\" title=\"" ++ pos ++ "\">"
|
||
|
++ concatMap esc (tokenText (thing tok))
|
||
|
++ "</span>"
|
||
|
where
|
||
|
pos = show (pp (srcRange tok)) ++ " " ++ show (tokenType (thing tok))
|
||
|
cl = case tokenType (thing tok) of
|
||
|
Num {} -> "number"
|
||
|
Ident {} -> "identifier"
|
||
|
KW {} -> "keyword"
|
||
|
Op {} -> "operator"
|
||
|
Sym {} -> "symbol"
|
||
|
Virt {} -> "virtual"
|
||
|
White Space -> "white"
|
||
|
White _ -> "comment"
|
||
|
Err {} -> "error"
|
||
|
EOF -> "eof"
|
||
|
StrLit {} -> "text"
|
||
|
ChrLit {} -> "text"
|
||
|
|
||
|
esc c = case c of
|
||
|
'<' -> "<"
|
||
|
'>' -> ">"
|
||
|
'&' -> "&"
|
||
|
' ' -> " "
|
||
|
'\n' -> "<br>"
|
||
|
_ -> [c]
|
||
|
|
||
|
sty :: String
|
||
|
sty = unlines
|
||
|
[ "<style>"
|
||
|
, "body { font-family: monospace }"
|
||
|
, ".number { color: #cc00cc }"
|
||
|
, ".identifier { }"
|
||
|
, ".keyword { color: blue; }"
|
||
|
, ".operator { color: #cc00cc }"
|
||
|
, ".symbol { color: blue }"
|
||
|
, ".white { }"
|
||
|
, ".virtual { background-color: red }"
|
||
|
, ".comment { color: green }"
|
||
|
, ".error { color: red }"
|
||
|
, ".text { color: #cc00cc }"
|
||
|
, "</style>"
|
||
|
]
|
||
|
|