-- |
-- 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

knownExts :: [String]
knownExts :: [String]
knownExts  =
  [ String
"cry"
  , String
"tex"
  , String
"markdown"
  , String
"md"
  ]

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
_           -> 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 (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


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 [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

  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 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
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 :: ([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 [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 Text
l
    | Text
"```" 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 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 = 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 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 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