-- |
-- 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 = Text -> Text
forall a. a -> a
id
unLit 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 PreProc
p =
  case PreProc
p of
    PreProc
None     -> Block -> [Block]
forall a. a -> [a]
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
    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) = [Text] -> ([Text], Text)
forall {a}. [a] -> ([a], a)
splitLast [Text]
rest
                 in Text
"/* " 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` Text
" */" ]

  where
  splitLast :: [a] -> ([a], a)
splitLast []  = String -> [String] -> ([a], a)
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
xa -> [a] -> [a]
forall 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 ([Text] -> [Text]
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 (Int
fence, [Text] -> Block
op) <- Text -> Maybe (Int, [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]
++ Int -> ([Text] -> Block) -> [Text] -> [Text] -> [Block]
fenced Int
fence [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

  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 (Int
fence, [Text] -> Block
op) <- Text -> Maybe (Int, [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]
++ Int -> ([Text] -> Block) -> [Text] -> [Text] -> [Block]
fenced Int
fence [Text] -> Block
op [] [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
    | 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 [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 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 :: Int -> ([Text] -> Block) -> [Text] -> [Text] -> [Block]
fenced Int
_ [Text] -> Block
op [Text]
current [] = ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
op [Text]
current  -- XXX should this be an error?
  fenced Int
fence [Text] -> Block
op [Text]
current (Text
l : [Text]
ls)
    | Int -> Text -> Bool
isCloseFence Int
fence 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         = Int -> ([Text] -> Block) -> [Text] -> [Text] -> [Block]
fenced Int
fence [Text] -> Block
op (Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
current) [Text]
ls


  isOpenFence :: Text -> Maybe (Int, [Text] -> Block)
isOpenFence Text
l
    | (Text
spaces, Text
l1) <- (Char -> Bool) -> Text -> (Text, Text)
Text.span (Char
' ' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) Text
l
    , (Text
ticks,  Text
l2) <- (Char -> Bool) -> Text -> (Text, Text)
Text.span(Char
'`' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) Text
l1
    , Int
3 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Text -> Int
Text.length Text
ticks
    , Bool -> Bool
not (Char -> Text -> Bool
Text.elem Char
'`' Text
l2)
    , let info :: Text
info = Text -> Text
Text.strip Text
l2
    , let n :: Int
n = Text -> Int
Text.length Text
spaces
    = (Int, [Text] -> Block) -> Maybe (Int, [Text] -> Block)
forall a. a -> Maybe a
Just (Text -> Int
Text.length Text
ticks, case Text
info of
              Text
"cryptol" -> [Text] -> Block
Code ([Text] -> Block) -> ([Text] -> [Text]) -> [Text] -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
trimIndent Int
n)
              Text
""        -> [Text] -> Block
Code ([Text] -> Block) -> ([Text] -> [Text]) -> [Text] -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
trimIndent Int
n)
              Text
_         -> [Text] -> Block
Comment)

    | Bool
otherwise = Maybe (Int, [Text] -> Block)
forall a. Maybe a
Nothing
    where
      trimIndent :: Int -> Text -> Text
trimIndent Int
n Text
t =
        case (Char -> Bool) -> Text -> (Text, Text)
Text.span (Char
' ' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) Text
t of
          (Text
prefix, Text
suffix)
            | Text -> Int
Text.length Text
prefix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n -> Text
suffix
            | Bool
otherwise -> Int -> Text -> Text
Text.drop Int
n Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix
  
  isCloseFence :: Int -> Text -> Bool
isCloseFence Int
fence Text
l =
    Int
fence Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Text -> Int
Text.length Text
ticks Bool -> Bool -> Bool
&&
    (Char -> Bool) -> Text -> Bool
Text.all (Char
' ' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) Text
l2
    where
      l1 :: Text
l1 = (Char -> Bool) -> Text -> Text
Text.dropWhile (Char
' ' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) Text
l
      (Text
ticks, Text
l2) = (Char -> Bool) -> Text -> (Text, Text)
Text.span (Char
'`' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) Text
l1

  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 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 [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 [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 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 (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
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 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"code-block::" Bool -> Bool -> Bool
||
                                              Text
dir Text -> Text -> Bool
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 Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc) [Text]
ls1
              | Bool
otherwise     -> [Text] -> [Text] -> [Block]
comment (Text
l Text -> [Text] -> [Text]
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 Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc) [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Text] -> [Text] -> [Block]
code [] [Text]
ls1
              | Bool
otherwise -> [Text] -> [Text] -> [Block]
codeOptions (Text
l Text -> [Text] -> [Text]
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 Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc) [Text]
ls1
              | Bool
otherwise  -> ([Text] -> Block) -> [Text] -> [Block]
mk [Text] -> Block
Code [Text]
acc [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Text] -> [Text] -> [Block]
comment [] [Text]
ls