1-- | 2-- Module : Cryptol.Parser.Unlit 3-- Copyright : (c) 2013-2016 Galois, Inc. 4-- License : BSD3 5-- Maintainer : cryptol@galois.com 6-- Stability : provisional 7-- Portability : portable 8-- 9-- Convert a literate source file into an ordinary source file. 10 11{-# LANGUAGE OverloadedStrings, Safe, PatternGuards #-} 12module Cryptol.Parser.Unlit 13 ( unLit, PreProc(..), guessPreProc, knownExts 14 ) where 15 16import Data.Text(Text) 17import qualified Data.Text as Text 18import Data.Char(isSpace) 19import System.FilePath(takeExtension) 20 21import Cryptol.Utils.Panic 22 23data PreProc = None | Markdown | LaTeX 24 25knownExts :: [String] 26knownExts = 27 [ "cry" 28 , "tex" 29 , "markdown" 30 , "md" 31 ] 32 33guessPreProc :: FilePath -> PreProc 34guessPreProc file = case takeExtension file of 35 ".tex" -> LaTeX 36 ".markdown" -> Markdown 37 ".md" -> Markdown 38 _ -> None 39 40unLit :: PreProc -> Text -> Text 41unLit None = id 42unLit proc = Text.unlines . concatMap toCryptol . preProc proc . Text.lines 43 44preProc :: PreProc -> [Text] -> [Block] 45preProc p = 46 case p of 47 None -> return . Code 48 Markdown -> markdown 49 LaTeX -> latex 50 51 52data Block = Code [Text] | Comment [Text] 53 54toCryptol :: Block -> [Text] 55toCryptol (Code xs) = xs 56toCryptol (Comment ls) = 57 case ls of 58 [] -> [] 59 [l] -> [ "/* " `Text.append` l `Text.append` " */" ] 60 l1 : rest -> let (more, l) = splitLast rest 61 in "/* " `Text.append` l1 : more ++ [ l `Text.append` " */" ] 62 63 where 64 splitLast [] = panic "Cryptol.Parser.Unlit.toCryptol" [ "splitLast []" ] 65 splitLast [x] = ([], x) 66 splitLast (x : xs) = let (ys,y) = splitLast xs 67 in (x:ys,y) 68 69 70mk :: ([Text] -> Block) -> [Text] -> [Block] 71mk _ [] = [] 72mk c ls = [ c (reverse ls) ] 73 74 75-- | The preprocessor for `markdown` 76markdown :: [Text] -> [Block] 77markdown = blanks [] 78 where 79 comment current [] = mk Comment current 80 comment current (l : ls) 81 | Just op <- isOpenFence l = mk Comment (l : current) ++ fenced op [] ls 82 | isBlank l = blanks (l : current) ls 83 | otherwise = comment (l : current) ls 84 85 blanks current [] = mk Comment current 86 blanks current (l : ls) 87 | Just op <- isOpenFence l = mk Comment (l : current) ++ fenced op [] ls 88 | isCodeLine l = mk Comment current ++ code [l] ls 89 | isBlank l = blanks (l : current) ls 90 | otherwise = comment (l : current) ls 91 92 code current [] = mk Code current 93 code current (l : ls) 94 | isCodeLine l = code (l : current) ls 95 | otherwise = mk Code current ++ comment [] (l : ls) 96 97 fenced op current [] = mk op current -- XXX should this be an error? 98 fenced op current (l : ls) 99 | isCloseFence l = mk op current ++ comment [l] ls 100 | otherwise = fenced op (l : current) ls 101 102 103 isOpenFence l 104 | "```" `Text.isPrefixOf` l' = 105 Just $ case Text.drop 3 l' of 106 l'' | "cryptol" `Text.isPrefixOf` l'' -> Code 107 | isBlank l'' -> Code 108 | otherwise -> Comment 109 110 | otherwise = Nothing 111 where 112 l' = Text.dropWhile isSpace l 113 114 isCloseFence l = "```" `Text.isPrefixOf` Text.dropWhile isSpace l 115 isBlank l = Text.all isSpace l 116 isCodeLine l = "\t" `Text.isPrefixOf` l || " " `Text.isPrefixOf` l 117 118 119 120-- | The preprocessor for `latex` 121latex :: [Text] -> [Block] 122latex = comment [] 123 where 124 comment current [] = mk Comment current 125 comment current (l : ls) 126 | isBeginCode l = mk Comment (l : current) ++ code [] ls 127 | otherwise = comment (l : current) ls 128 129 code current [] = mk Code current 130 code current (l : ls) 131 | isEndCode l = mk Code current ++ comment [l] ls 132 | otherwise = code (l : current) ls 133 134 isBeginCode l = "\\begin{code}" `Text.isPrefixOf` l 135 isEndCode l = "\\end{code}" `Text.isPrefixOf` l 136 137 138 139 140