{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
module Language.Rzk.Syntax (
  module Language.Rzk.Syntax.Abs,

  parseModule,
  parseModuleRzk,
  parseModuleFile,
  parseTerm,
  printTree,
  tryExtractMarkdownCodeBlocks,
  extractMarkdownCodeBlocks,
) where

import           Data.Char                  (isSpace)
import qualified Data.List                  as List

import           Language.Rzk.Syntax.Abs
import           Language.Rzk.Syntax.Print  (printTree)

import           Language.Rzk.Syntax.Layout (resolveLayout)
import           Language.Rzk.Syntax.Lex    (tokens)
import           Language.Rzk.Syntax.Par    (pModule, pTerm)

parseModule :: String -> Either String Module
parseModule :: [Char] -> Either [Char] Module
parseModule = [Token] -> Either [Char] Module
pModule forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Token] -> [Token]
resolveLayout Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Token]
tokens forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
tryExtractMarkdownCodeBlocks [Char]
"rzk"

parseModuleRzk :: String -> Either String Module
parseModuleRzk :: [Char] -> Either [Char] Module
parseModuleRzk = [Token] -> Either [Char] Module
pModule forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Token] -> [Token]
resolveLayout Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Token]
tokens

parseModuleFile :: FilePath -> IO (Either String Module)
parseModuleFile :: [Char] -> IO (Either [Char] Module)
parseModuleFile [Char]
path = do
  [Char] -> Either [Char] Module
parseModule forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [Char]
readFile [Char]
path

parseTerm :: String -> Either String Term
parseTerm :: [Char] -> Either [Char] Term
parseTerm = [Token] -> Either [Char] Term
pTerm forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Token]
tokens

tryExtractMarkdownCodeBlocks :: String -> String -> String
tryExtractMarkdownCodeBlocks :: [Char] -> [Char] -> [Char]
tryExtractMarkdownCodeBlocks [Char]
alias [Char]
input
  | ([Char]
"```" forall a. Semigroup a => a -> a -> a
<> [Char]
alias forall a. Semigroup a => a -> a -> a
<> [Char]
"\n") forall a. Eq a => [a] -> [a] -> Bool
`List.isInfixOf` [Char]
input = [Char] -> [Char] -> [Char]
extractMarkdownCodeBlocks [Char]
alias [Char]
input
  | Bool
otherwise = [Char]
input

data LineType = NonCode | CodeOf String

-- | Extract code for a given alias (e.g. "rzk" or "haskell") from a Markdown file
-- by replacing any lines that do not belong to the code in that language with blank lines.
-- This way the line numbers are preserved correctly from the original file.
--
-- All of the following notations are supported to start a code block:
--
-- * @```rzk@
-- * @```{.rzk title=\"Example\"}@
-- * @``` { .rzk title=\"Example\" }@
--
-- >>> example = "Example:\n```rzk\n#lang rzk-1\n```\nasd asd\n```rzk\n#def x : U\n  := U\n``` \nasda"
-- >>> putStrLn example
-- Example:
-- ```rzk
-- #lang rzk-1
-- ```
-- asd asd
-- ```rzk
-- #def x : U
--   := U
-- ```
-- asda
-- >>> putStrLn $ extractMarkdownCodeBlocks "rzk" example
-- <BLANKLINE>
-- <BLANKLINE>
-- #lang rzk-1
-- <BLANKLINE>
-- <BLANKLINE>
-- <BLANKLINE>
-- #def x : U
--   := U
-- <BLANKLINE>
-- <BLANKLINE>
-- <BLANKLINE>
extractMarkdownCodeBlocks :: String -> String -> String
extractMarkdownCodeBlocks :: [Char] -> [Char] -> [Char]
extractMarkdownCodeBlocks [Char]
alias = [[Char]] -> [Char]
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineType -> [[Char]] -> [[Char]]
blankNonCode LineType
NonCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
trim forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines
  where
    blankNonCode :: LineType -> [[Char]] -> [[Char]]
blankNonCode LineType
_prevType [] = []
    blankNonCode LineType
prevType ([Char]
line : [[Char]]
lines_) =
      case LineType
prevType of
        CodeOf [Char]
lang
          | [Char]
line forall a. Eq a => a -> a -> Bool
== [Char]
"```" -> [Char]
"" forall a. a -> [a] -> [a]
: LineType -> [[Char]] -> [[Char]]
blankNonCode LineType
NonCode [[Char]]
lines_
          | [Char]
lang forall a. Eq a => a -> a -> Bool
== [Char]
alias -> [Char]
line forall a. a -> [a] -> [a]
: LineType -> [[Char]] -> [[Char]]
blankNonCode LineType
prevType [[Char]]
lines_
          | Bool
otherwise     -> [Char]
""   forall a. a -> [a] -> [a]
: LineType -> [[Char]] -> [[Char]]
blankNonCode LineType
prevType [[Char]]
lines_
        LineType
NonCode -> [Char]
"" forall a. a -> [a] -> [a]
: LineType -> [[Char]] -> [[Char]]
blankNonCode ([Char] -> LineType
identifyCodeBlockStart [Char]
line) [[Char]]
lines_

    trim :: [Char] -> [Char]
trim = forall a. (a -> Bool) -> [a] -> [a]
List.dropWhileEnd Char -> Bool
isSpace

identifyCodeBlockStart :: String -> LineType
identifyCodeBlockStart :: [Char] -> LineType
identifyCodeBlockStart [Char]
line
  | [Char]
prefix forall a. Eq a => a -> a -> Bool
== [Char]
"```" =
      case [Char] -> [[Char]]
words [Char]
suffix of
        []                          -> [Char] -> LineType
CodeOf [Char]
"text" -- default to text
        (Char
'{':Char
'.':[Char]
lang) : [[Char]]
_options   -> [Char] -> LineType
CodeOf [Char]
lang   -- ``` {.rzk ...
        [Char]
"{" : (Char
'.':[Char]
lang) : [[Char]]
_options -> [Char] -> LineType
CodeOf [Char]
lang   -- ``` { .rzk ...
        [Char]
lang : [[Char]]
_options             -> [Char] -> LineType
CodeOf [Char]
lang   -- ```rzk ...
  | Bool
otherwise = LineType
NonCode
  where
    ([Char]
prefix, [Char]
suffix) = forall a. Int -> [a] -> ([a], [a])
List.splitAt Int
3 [Char]
line