{-# LANGUAGE OverloadedStrings, Safe, PatternGuards #-}
module Cryptol.Parser.Unlit
( unLit, PreProc(..), guessPreProc, knownExts
) where
import Data.Text(Text)
import qualified Data.Text as Text
import Data.Char(isSpace)
import System.FilePath(takeExtension)
import Cryptol.Utils.Panic
data PreProc = None | Markdown | LaTeX | RST
knownExts :: [String]
knownExts :: [String]
knownExts =
[ String
"cry"
, String
"tex"
, String
"markdown"
, String
"md"
, String
"rst"
]
guessPreProc :: FilePath -> PreProc
guessPreProc :: String -> PreProc
guessPreProc String
file = case String -> String
takeExtension String
file of
String
".tex" -> PreProc
LaTeX
String
".markdown" -> PreProc
Markdown
String
".md" -> PreProc
Markdown
String
".rst" -> PreProc
RST
String
_ -> PreProc
None
unLit :: PreProc -> Text -> Text
unLit :: PreProc -> Text -> Text
unLit PreProc
None = forall a. a -> a
id
unLit PreProc
proc = [Text] -> Text
Text.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Block -> [Text]
toCryptol forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreProc -> [Text] -> [Block]
preProc PreProc
proc forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.lines
preProc :: PreProc -> [Text] -> [Block]
preProc :: PreProc -> [Text] -> [Block]
preProc PreProc
p =
case PreProc
p of
PreProc
None -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Block
Code
PreProc
Markdown -> [Text] -> [Block]
markdown
PreProc
LaTeX -> [Text] -> [Block]
latex
PreProc
RST -> [Text] -> [Block]
rst
data Block = Code [Text] | [Text]
toCryptol :: Block -> [Text]
toCryptol :: Block -> [Text]
toCryptol (Code [Text]
xs) = [Text]
xs
toCryptol (Comment [Text]
ls) =
case [Text]
ls of
[] -> []
[Text
l] -> [ Text
"/* " Text -> Text -> Text
`Text.append` Text
l Text -> Text -> Text
`Text.append` Text
" */" ]
Text
l1 : [Text]
rest -> let ([Text]
more, Text
l) = forall {a}. [a] -> ([a], a)
splitLast [Text]
rest
in Text
"/* " Text -> Text -> Text
`Text.append` Text
l1 forall a. a -> [a] -> [a]
: [Text]
more forall a. [a] -> [a] -> [a]
++ [ Text
l Text -> Text -> Text
`Text.append` Text
" */" ]
where
splitLast :: [a] -> ([a], a)
splitLast [] = forall a. HasCallStack => String -> [String] -> a
panic String
"Cryptol.Parser.Unlit.toCryptol" [ String
"splitLast []" ]
splitLast [a
x] = ([], a
x)
splitLast (a
x : [a]
xs) = let ([a]
ys,a
y) = [a] -> ([a], a)
splitLast [a]
xs
in (a
xforall a. a -> [a] -> [a]
:[a]
ys,a
y)
mk :: ([Text] -> Block) -> [Text] -> [Block]
mk :: ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
_ [] = []
mk [Text] -> Block
c [Text]
ls = [ [Text] -> Block
c (forall a. [a] -> [a]
reverse [Text]
ls) ]
markdown :: [Text] -> [Block]
markdown :: [Text] -> [Block]
markdown = [Text] -> [Text] -> [Block]
blanks []
where
comment :: [Text] -> [Text] -> [Block]
comment [Text]
current [] = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Comment [Text]
current
comment [Text]
current (Text
l : [Text]
ls)
| Just [Text] -> Block
op <- Text -> Maybe ([Text] -> Block)
isOpenFence Text
l = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Comment (Text
l forall a. a -> [a] -> [a]
: [Text]
current) forall a. [a] -> [a] -> [a]
++ ([Text] -> Block) -> [Text] -> [Text] -> [Block]
fenced [Text] -> Block
op [] [Text]
ls
| Text -> Bool
isBlank Text
l = [Text] -> [Text] -> [Block]
blanks (Text
l forall a. a -> [a] -> [a]
: [Text]
current) [Text]
ls
| Bool
otherwise = [Text] -> [Text] -> [Block]
comment (Text
l forall a. a -> [a] -> [a]
: [Text]
current) [Text]
ls
blanks :: [Text] -> [Text] -> [Block]
blanks [Text]
current [] = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Comment [Text]
current
blanks [Text]
current (Text
l : [Text]
ls)
| Just [Text] -> Block
op <- Text -> Maybe ([Text] -> Block)
isOpenFence Text
l = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Comment (Text
l forall a. a -> [a] -> [a]
: [Text]
current) forall a. [a] -> [a] -> [a]
++ ([Text] -> Block) -> [Text] -> [Text] -> [Block]
fenced [Text] -> Block
op [] [Text]
ls
| Text -> Bool
isCodeLine Text
l = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Comment [Text]
current forall a. [a] -> [a] -> [a]
++ [Text] -> [Text] -> [Block]
code [Text
l] [Text]
ls
| Text -> Bool
isBlank Text
l = [Text] -> [Text] -> [Block]
blanks (Text
l forall a. a -> [a] -> [a]
: [Text]
current) [Text]
ls
| Bool
otherwise = [Text] -> [Text] -> [Block]
comment (Text
l forall a. a -> [a] -> [a]
: [Text]
current) [Text]
ls
code :: [Text] -> [Text] -> [Block]
code [Text]
current [] = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Code [Text]
current
code [Text]
current (Text
l : [Text]
ls)
| Text -> Bool
isCodeLine Text
l = [Text] -> [Text] -> [Block]
code (Text
l forall a. a -> [a] -> [a]
: [Text]
current) [Text]
ls
| Bool
otherwise = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Code [Text]
current forall a. [a] -> [a] -> [a]
++ [Text] -> [Text] -> [Block]
comment [] (Text
l forall a. a -> [a] -> [a]
: [Text]
ls)
fenced :: ([Text] -> Block) -> [Text] -> [Text] -> [Block]
fenced [Text] -> Block
op [Text]
current [] = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
op [Text]
current
fenced [Text] -> Block
op [Text]
current (Text
l : [Text]
ls)
| Text -> Bool
isCloseFence Text
l = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
op [Text]
current forall a. [a] -> [a] -> [a]
++ [Text] -> [Text] -> [Block]
comment [Text
l] [Text]
ls
| Bool
otherwise = ([Text] -> Block) -> [Text] -> [Text] -> [Block]
fenced [Text] -> Block
op (Text
l forall a. a -> [a] -> [a]
: [Text]
current) [Text]
ls
isOpenFence :: Text -> Maybe ([Text] -> Block)
isOpenFence Text
l
| Text
"```" Text -> Text -> Bool
`Text.isPrefixOf` Text
l' =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case (Char -> Bool) -> Text -> Text
Text.dropWhile Char -> Bool
isSpace (Int -> Text -> Text
Text.drop Int
3 Text
l') of
Text
l'' | Text
"cryptol" Text -> Text -> Bool
`Text.isPrefixOf` Text
l'' -> [Text] -> Block
Code
| Text -> Bool
isBlank Text
l'' -> [Text] -> Block
Code
| Bool
otherwise -> [Text] -> Block
Comment
| Bool
otherwise = forall a. Maybe a
Nothing
where
l' :: Text
l' = (Char -> Bool) -> Text -> Text
Text.dropWhile Char -> Bool
isSpace Text
l
isCloseFence :: Text -> Bool
isCloseFence Text
l = Text
"```" Text -> Text -> Bool
`Text.isPrefixOf` (Char -> Bool) -> Text -> Text
Text.dropWhile Char -> Bool
isSpace Text
l
isBlank :: Text -> Bool
isBlank Text
l = (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
isSpace Text
l
isCodeLine :: Text -> Bool
isCodeLine Text
l = Text
"\t" Text -> Text -> Bool
`Text.isPrefixOf` Text
l Bool -> Bool -> Bool
|| Text
" " Text -> Text -> Bool
`Text.isPrefixOf` Text
l
latex :: [Text] -> [Block]
latex :: [Text] -> [Block]
latex = [Text] -> [Text] -> [Block]
comment []
where
comment :: [Text] -> [Text] -> [Block]
comment [Text]
current [] = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Comment [Text]
current
comment [Text]
current (Text
l : [Text]
ls)
| Text -> Bool
isBeginCode Text
l = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Comment (Text
l forall a. a -> [a] -> [a]
: [Text]
current) forall a. [a] -> [a] -> [a]
++ [Text] -> [Text] -> [Block]
code [] [Text]
ls
| Bool
otherwise = [Text] -> [Text] -> [Block]
comment (Text
l forall a. a -> [a] -> [a]
: [Text]
current) [Text]
ls
code :: [Text] -> [Text] -> [Block]
code [Text]
current [] = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Code [Text]
current
code [Text]
current (Text
l : [Text]
ls)
| Text -> Bool
isEndCode Text
l = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Code [Text]
current forall a. [a] -> [a] -> [a]
++ [Text] -> [Text] -> [Block]
comment [Text
l] [Text]
ls
| Bool
otherwise = [Text] -> [Text] -> [Block]
code (Text
l forall a. a -> [a] -> [a]
: [Text]
current) [Text]
ls
isBeginCode :: Text -> Bool
isBeginCode Text
l = Text
"\\begin{code}" Text -> Text -> Bool
`Text.isPrefixOf` Text
l
isEndCode :: Text -> Bool
isEndCode Text
l = Text
"\\end{code}" Text -> Text -> Bool
`Text.isPrefixOf` Text
l
rst :: [Text] -> [Block]
rst :: [Text] -> [Block]
rst = [Text] -> [Text] -> [Block]
comment []
where
isBeginCode :: Text -> Bool
isBeginCode Text
l = case forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null) ((Char -> Bool) -> Text -> [Text]
Text.split Char -> Bool
isSpace Text
l) of
[Text
"..", Text
dir, Text
"cryptol"] -> Text
dir forall a. Eq a => a -> a -> Bool
== Text
"code-block::" Bool -> Bool -> Bool
||
Text
dir forall a. Eq a => a -> a -> Bool
== Text
"sourcecode::"
[Text]
_ -> Bool
False
isEmpty :: Text -> Bool
isEmpty = (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
isSpace
isCode :: Text -> Bool
isCode Text
l = case Text -> Maybe (Char, Text)
Text.uncons Text
l of
Just (Char
c, Text
_) -> Char -> Bool
isSpace Char
c
Maybe (Char, Text)
Nothing -> Bool
True
comment :: [Text] -> [Text] -> [Block]
comment [Text]
acc [Text]
ls =
case [Text]
ls of
[] -> ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Comment [Text]
acc
Text
l : [Text]
ls1 | Text -> Bool
isBeginCode Text
l -> [Text] -> [Text] -> [Block]
codeOptions (Text
l forall a. a -> [a] -> [a]
: [Text]
acc) [Text]
ls1
| Bool
otherwise -> [Text] -> [Text] -> [Block]
comment (Text
l forall a. a -> [a] -> [a]
: [Text]
acc) [Text]
ls1
codeOptions :: [Text] -> [Text] -> [Block]
codeOptions [Text]
acc [Text]
ls =
case [Text]
ls of
[] -> ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Comment [Text]
acc
Text
l : [Text]
ls1 | Text -> Bool
isEmpty Text
l -> ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Comment (Text
l forall a. a -> [a] -> [a]
: [Text]
acc) forall a. [a] -> [a] -> [a]
++ [Text] -> [Text] -> [Block]
code [] [Text]
ls1
| Bool
otherwise -> [Text] -> [Text] -> [Block]
codeOptions (Text
l forall a. a -> [a] -> [a]
: [Text]
acc) [Text]
ls1
code :: [Text] -> [Text] -> [Block]
code [Text]
acc [Text]
ls =
case [Text]
ls of
[] -> ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Code [Text]
acc
Text
l : [Text]
ls1 | Text -> Bool
isCode Text
l -> [Text] -> [Text] -> [Block]
code (Text
l forall a. a -> [a] -> [a]
: [Text]
acc) [Text]
ls1
| Bool
otherwise -> ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Code [Text]
acc forall a. [a] -> [a] -> [a]
++ [Text] -> [Text] -> [Block]
comment [] [Text]
ls