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

  parseModuleSafe,
  parseModule,
  parseModuleRzk,
  parseModuleFile,
  parseTerm,
  printTree,
  tryExtractMarkdownCodeBlocks,
  extractMarkdownCodeBlocks,
  tryOrDisplayException,
  tryOrDisplayExceptionIO,
) where

import           Control.Exception          (Exception (..), SomeException,
                                             evaluate, try)

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)

tryOrDisplayException :: Either String a -> IO (Either String a)
tryOrDisplayException :: forall a. Either [Char] a -> IO (Either [Char] a)
tryOrDisplayException = forall a. IO (Either [Char] a) -> IO (Either [Char] a)
tryOrDisplayExceptionIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> IO a
evaluate

tryOrDisplayExceptionIO :: IO (Either String a) -> IO (Either String a)
tryOrDisplayExceptionIO :: forall a. IO (Either [Char] a) -> IO (Either [Char] a)
tryOrDisplayExceptionIO IO (Either [Char] a)
x =
  forall e a. Exception e => IO a -> IO (Either e a)
try IO (Either [Char] a)
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left (SomeException
ex :: SomeException) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (forall e. Exception e => e -> [Char]
displayException SomeException
ex))
    Right Either [Char] a
result               -> forall (m :: * -> *) a. Monad m => a -> m a
return Either [Char] a
result

parseModuleSafe :: String -> IO (Either String Module)
parseModuleSafe :: [Char] -> IO (Either [Char] Module)
parseModuleSafe = forall a. Either [Char] a -> IO (Either [Char] a)
tryOrDisplayException forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either [Char] Module
parseModule

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]
source <- [Char] -> IO [Char]
readFile [Char]
path
  [Char] -> IO (Either [Char] Module)
parseModuleSafe [Char]
source

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