    -- |
    -- 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  =
      [ "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] | Comment [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) ]

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

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