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

    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