{-# 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
knownExts :: [String]
knownExts :: [String]
knownExts =
[ "cry"
, "tex"
, "markdown"
, "md"
]
guessPreProc :: FilePath -> PreProc
guessPreProc :: String -> PreProc
guessPreProc file :: String
file = case String -> String
takeExtension String
file of
".tex" -> PreProc
LaTeX
".markdown" -> PreProc
Markdown
".md" -> PreProc
Markdown
_ -> PreProc
None
unLit :: PreProc -> Text -> Text
unLit :: PreProc -> Text -> Text
unLit None = Text -> Text
forall a. a -> a
id
unLit proc :: PreProc
proc = [Text] -> Text
Text.unlines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> [Text]) -> [Block] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Block -> [Text]
toCryptol ([Block] -> [Text]) -> (Text -> [Block]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreProc -> [Text] -> [Block]
preProc PreProc
proc ([Text] -> [Block]) -> (Text -> [Text]) -> Text -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.lines
preProc :: PreProc -> [Text] -> [Block]
preProc :: PreProc -> [Text] -> [Block]
preProc p :: PreProc
p =
case PreProc
p of
None -> Block -> [Block]
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> [Block]) -> ([Text] -> Block) -> [Text] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Block
Code
Markdown -> [Text] -> [Block]
markdown
LaTeX -> [Text] -> [Block]
latex
data Block = Code [Text] | [Text]
toCryptol :: Block -> [Text]
toCryptol :: Block -> [Text]
toCryptol (Code xs :: [Text]
xs) = [Text]
xs
toCryptol (Comment ls :: [Text]
ls) =
case [Text]
ls of
[] -> []
[l :: Text
l] -> [ "/* " Text -> Text -> Text
`Text.append` Text
l Text -> Text -> Text
`Text.append` " */" ]
l1 :: Text
l1 : rest :: [Text]
rest -> let (more :: [Text]
more, l :: Text
l) = [Text] -> ([Text], Text)
forall a. [a] -> ([a], a)
splitLast [Text]
rest
in "/* " Text -> Text -> Text
`Text.append` Text
l1 Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
more [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
l Text -> Text -> Text
`Text.append` " */" ]
where
splitLast :: [a] -> ([a], a)
splitLast [] = String -> [String] -> ([a], a)
forall a. HasCallStack => String -> [String] -> a
panic "Cryptol.Parser.Unlit.toCryptol" [ "splitLast []" ]
splitLast [x :: a
x] = ([], a
x)
splitLast (x :: a
x : xs :: [a]
xs) = let (ys :: [a]
ys,y :: a
y) = [a] -> ([a], a)
splitLast [a]
xs
in (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys,a
y)
mk :: ([Text] -> Block) -> [Text] -> [Block]
mk :: ([Text] -> Block) -> [Text] -> [Block]
mk _ [] = []
mk c :: [Text] -> Block
c ls :: [Text]
ls = [ [Text] -> Block
c ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
ls) ]
markdown :: [Text] -> [Block]
markdown :: [Text] -> [Block]
markdown = [Text] -> [Text] -> [Block]
blanks []
where
comment :: [Text] -> [Text] -> [Block]
comment current :: [Text]
current [] = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Comment [Text]
current
comment current :: [Text]
current (l :: Text
l : ls :: [Text]
ls)
| Text -> Bool
isBlank Text
l = [Text] -> [Text] -> [Block]
blanks (Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
current) [Text]
ls
| Bool
otherwise = [Text] -> [Text] -> [Block]
comment (Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
current) [Text]
ls
blanks :: [Text] -> [Text] -> [Block]
blanks current :: [Text]
current [] = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Comment [Text]
current
blanks current :: [Text]
current (l :: Text
l : ls :: [Text]
ls)
| Text -> Bool
isCodeLine Text
l = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Comment [Text]
current [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Text] -> [Text] -> [Block]
code [Text
l] [Text]
ls
| Just op :: [Text] -> Block
op <- Text -> Maybe ([Text] -> Block)
isOpenFence Text
l = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Comment (Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
current) [Block] -> [Block] -> [Block]
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 Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
current) [Text]
ls
| Bool
otherwise = [Text] -> [Text] -> [Block]
comment (Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
current) [Text]
ls
code :: [Text] -> [Text] -> [Block]
code current :: [Text]
current [] = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Code [Text]
current
code current :: [Text]
current (l :: Text
l : ls :: [Text]
ls)
| Text -> Bool
isCodeLine Text
l = [Text] -> [Text] -> [Block]
code (Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
current) [Text]
ls
| Bool
otherwise = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Code [Text]
current [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Text] -> [Text] -> [Block]
comment [] (Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ls)
fenced :: ([Text] -> Block) -> [Text] -> [Text] -> [Block]
fenced op :: [Text] -> Block
op current :: [Text]
current [] = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
op [Text]
current
fenced op :: [Text] -> Block
op current :: [Text]
current (l :: Text
l : ls :: [Text]
ls)
| Text -> Bool
isCloseFence Text
l = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
op [Text]
current [Block] -> [Block] -> [Block]
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 Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
current) [Text]
ls
isOpenFence :: Text -> Maybe ([Text] -> Block)
isOpenFence l :: Text
l
| "```" Text -> Text -> Bool
`Text.isPrefixOf` Text
l' =
([Text] -> Block) -> Maybe ([Text] -> Block)
forall a. a -> Maybe a
Just (([Text] -> Block) -> Maybe ([Text] -> Block))
-> ([Text] -> Block) -> Maybe ([Text] -> Block)
forall a b. (a -> b) -> a -> b
$ case Int -> Text -> Text
Text.drop 3 Text
l' of
l'' :: Text
l'' | "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 = Maybe ([Text] -> Block)
forall a. Maybe a
Nothing
where
l' :: Text
l' = (Char -> Bool) -> Text -> Text
Text.dropWhile Char -> Bool
isSpace Text
l
isCloseFence :: Text -> Bool
isCloseFence l :: Text
l = "```" Text -> Text -> Bool
`Text.isPrefixOf` Text
l
isBlank :: Text -> Bool
isBlank l :: Text
l = (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
isSpace Text
l
isCodeLine :: Text -> Bool
isCodeLine l :: Text
l = "\t" Text -> Text -> Bool
`Text.isPrefixOf` Text
l Bool -> Bool -> Bool
|| " " Text -> Text -> Bool
`Text.isPrefixOf` Text
l
latex :: [Text] -> [Block]
latex :: [Text] -> [Block]
latex = [Text] -> [Text] -> [Block]
comment []
where
comment :: [Text] -> [Text] -> [Block]
comment current :: [Text]
current [] = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Comment [Text]
current
comment current :: [Text]
current (l :: Text
l : ls :: [Text]
ls)
| Text -> Bool
isBeginCode Text
l = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Comment (Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
current) [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Text] -> [Text] -> [Block]
code [] [Text]
ls
| Bool
otherwise = [Text] -> [Text] -> [Block]
comment (Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
current) [Text]
ls
code :: [Text] -> [Text] -> [Block]
code current :: [Text]
current [] = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Code [Text]
current
code current :: [Text]
current (l :: Text
l : ls :: [Text]
ls)
| Text -> Bool
isEndCode Text
l = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Code [Text]
current [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Text] -> [Text] -> [Block]
comment [Text
l] [Text]
ls
| Bool
otherwise = [Text] -> [Text] -> [Block]
code (Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
current) [Text]
ls
isBeginCode :: Text -> Bool
isBeginCode l :: Text
l = "\\begin{code}" Text -> Text -> Bool
`Text.isPrefixOf` Text
l
isEndCode :: Text -> Bool
isEndCode l :: Text
l = "\\end{code}" Text -> Text -> Bool
`Text.isPrefixOf` Text
l