-- |
-- Module      :  Cryptol.Parser.Unlit
-- Copyright   :  (c) 2013-2016 Galois, Inc.
-- License     :  BSD3
-- Maintainer  :  cryptol@galois.com
-- Stability   :  provisional
-- Portability :  portable
--
-- Convert a literate source file into an ordinary source file.

{-# 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] | Comment [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) ]


-- | The preprocessor for `markdown`
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  -- XXX should this be an error?
  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



-- | The preprocessor for `latex`
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