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

-- | Extract rzk code from a Markdown file
--
-- >>> putStrLn $ detectMarkdownCodeBlocks "\n```rzk\n#lang rzk-1\n```\nasd asd\n```rzk\n#def x : U\n  := U\n``` asda"
-- #lang rzk-1
-- #def x : U
--   := U
extractMarkdownCodeBlocks :: String -> String -> String
extractMarkdownCodeBlocks :: [Char] -> [Char] -> [Char]
extractMarkdownCodeBlocks [Char]
alias = [[Char]] -> [Char]
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [[Char]] -> [[Char]]
blankNonCode Bool
True 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 :: Bool -> [[Char]] -> [[Char]]
blankNonCode Bool
_toBlank [] = []
    blankNonCode Bool
True ([Char]
line : [[Char]]
lines_)
      | [Char]
line forall a. Eq a => a -> a -> Bool
== [Char]
"```" forall a. Semigroup a => a -> a -> a
<> [Char]
alias  = [Char]
"" forall a. a -> [a] -> [a]
: Bool -> [[Char]] -> [[Char]]
blankNonCode Bool
False [[Char]]
lines_
      | Bool
otherwise               = [Char]
"" forall a. a -> [a] -> [a]
: Bool -> [[Char]] -> [[Char]]
blankNonCode Bool
True  [[Char]]
lines_
    blankNonCode Bool
False ([Char]
line : [[Char]]
lines_)
      | [Char]
line forall a. Eq a => a -> a -> Bool
== [Char]
"```"           = [Char]
"" forall a. a -> [a] -> [a]
: Bool -> [[Char]] -> [[Char]]
blankNonCode Bool
True [[Char]]
lines_
      | Bool
otherwise               = [Char]
line forall a. a -> [a] -> [a]
: Bool -> [[Char]] -> [[Char]]
blankNonCode Bool
False [[Char]]
lines_

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