GaloisInc/cryptol
1
1
Fork 0
mirror of https://github.com/GaloisInc/cryptol.git synced 2024-11-24 15:08:58 +03:00
Code Issues Projects Releases Wiki Activity

Fix up html syntax highlighting.

Browse Source
This commit is contained in:
Iavor Diatchki 2017-10-25 11:12:37 -07:00
parent c666731495
commit 5c51d32a4e
3 changed files with 18 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
cryptol.cabal
View File

@ -219,6 +219,12 @@ executable cryptol
if os(linux) && flag(static)
ld-options: -static -pthread
executable cryptol-html
main-is: CryHtml.hs
hs-source-dirs: utils
build-depends: base, text, cryptol
GHC-options: -Wall
-- Note: the Cryptol server needs to be updated to some new APIs.
--executable cryptol-server
-- main-is: Main.hs

1
src/Cryptol/Parser/LexerUtils.hs
View File

@ -391,7 +391,6 @@ data TokenKW = KW_else
| KW_constraint
deriving (Eq, Show, Generic, NFData)
-- | The named operators are a special case for parsing types, and 'Other' is
-- | The named operators are a special case for parsing types, and 'Other' is
-- used for all other cases that lexed as an operator.
data TokenOp = Plus | Minus | Mul | Div | Exp | Mod

15
utils/CryHtml.hs
View File

@ -10,19 +10,27 @@
import Cryptol.Parser.Lexer
import Cryptol.Utils.PP
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
main :: IO ()
main = interact (wrap . concat . map toHTML . fst . primLexer defaultConfig)
main =
do txt <- Text.getContents
putStrLn $ wrap
$ concat
$ map toHTML
$ fst
$ primLexer defaultConfig txt
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))
++ concatMap esc (Text.unpack (tokenText (thing tok)))
++ "</span>"
where
pos = show (pp (srcRange tok)) ++ " " ++ show (tokenType (thing tok))
pos = show (pp (srcRange tok)) ++ " " ++ concatMap esc (show (tokenType (thing tok)))
cl = case tokenType (thing tok) of
Num {} -> "number"
Ident {} -> "identifier"
@ -42,6 +50,7 @@ toHTML tok = "<span class=\"" ++ cl ++ "\" title=\"" ++ pos ++ "\">"
'>' -> "&gt;"
'&' -> "&amp;"
' ' -> "&nbsp;"
'"' -> "&quot;"
'\n' -> "<br>"
_ -> [c]