{-# 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
[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
extractMarkdownCodeBlocks :: String -> String -> String
[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"
(Char
'{':Char
'.':[Char]
lang) : [[Char]]
_options -> [Char] -> LineType
CodeOf [Char]
lang
[Char]
"{" : (Char
'.':[Char]
lang) : [[Char]]
_options -> [Char] -> LineType
CodeOf [Char]
lang
[Char]
lang : [[Char]]
_options -> [Char] -> LineType
CodeOf [Char]
lang
| Bool
otherwise = LineType
NonCode
where
([Char]
prefix, [Char]
suffix) = forall a. Int -> [a] -> ([a], [a])
List.splitAt Int
3 [Char]
line