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