{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}
{-|
Module      : Htcc.Parser.Utils.Core
Description : The AST data type and its utilities
Copyright   : (c) roki, 2019
License     : MIT
Maintainer  : falgon53@yahoo.co.jp
Stability   : experimental
Portability : POSIX

The utilities of parsing
-}
module Htcc.Parser.Utils.Core (
    -- * General utilities of parser
    expectedMessage,
    -- * Utilities of the token
    takeBrace,
    takeExps
) where

import qualified Data.Text                                       as T
import           Data.Tuple.Extra                                (first)

import           Htcc.Parser.ConstructionData.Scope.ManagedScope (ASTError)
import qualified Htcc.Tokenizer.Token                            as HT
import           Htcc.Utils                                      (lastInit,
                                                                  maybe', tshow)

-- | "expected" error message
expectedMessage :: Show i => T.Text -> HT.TokenLC i -> [HT.TokenLC i] -> ASTError i
expectedMessage :: Text -> TokenLC i -> [TokenLC i] -> ASTError i
expectedMessage x :: Text
x t :: TokenLC i
t xs :: [TokenLC i]
xs
    | [TokenLC i] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TokenLC i]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 = ("expected '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' token before '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Token i -> Text
forall a. Show a => a -> Text
tshow (TokenLC i -> Token i
forall a b. (a, b) -> b
snd ([TokenLC i]
xs [TokenLC i] -> Int -> TokenLC i
forall a. [a] -> Int -> a
!! 1)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "'", [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
xs)
    | Bool
otherwise = ("expected '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' token", if [TokenLC i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TokenLC i]
xs then TokenLC i
t else [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
xs)

-- | Extract the partial token enclosed in parentheses from the token sequence. If it is invalid, `takeBrace` returns @(i, Text)@ indicating the error location.
-- Otherwise, `takeBrace` returns a partial token enclosed in parentheses and subsequent tokens.
takeBrace :: forall i. (Integral i, Read i, Show i) => T.Text -> T.Text -> [HT.TokenLC i] -> Maybe (Either (HT.TokenLC i) ([HT.TokenLC i], [HT.TokenLC i]))
takeBrace :: Text
-> Text
-> [TokenLC i]
-> Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
takeBrace leftb :: Text
leftb rightb :: Text
rightb xxs :: [TokenLC i]
xxs@((_, HT.TKReserved y :: Text
y):_)
    | Text
y Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
leftb = Either (TokenLC i) ([TokenLC i], [TokenLC i])
-> Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
forall a. a -> Maybe a
Just (Either (TokenLC i) ([TokenLC i], [TokenLC i])
 -> Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i])))
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
-> Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> [TokenLC i]
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
f 0 0 [TokenLC i]
xxs
    | Bool
otherwise = Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
forall a. Maybe a
Nothing
    where
        f :: Int -> Int -> [HT.TokenLC i] -> Either (HT.TokenLC i) ([HT.TokenLC i], [HT.TokenLC i])
        f :: Int
-> Int
-> [TokenLC i]
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
f !Int
l !Int
r []
            | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
r = TokenLC i -> Either (TokenLC i) ([TokenLC i], [TokenLC i])
forall a b. a -> Either a b
Left (TokenLC i -> Either (TokenLC i) ([TokenLC i], [TokenLC i]))
-> TokenLC i -> Either (TokenLC i) ([TokenLC i], [TokenLC i])
forall a b. (a -> b) -> a -> b
$ [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
xxs
            | Bool
otherwise = ([TokenLC i], [TokenLC i])
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
forall a b. b -> Either a b
Right ([], [])
        f !Int
l !Int
r (c :: TokenLC i
c@(p :: TokenLCNums i
p, HT.TKReserved x :: Text
x):xs' :: [TokenLC i]
xs')
            | Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
rightb = if Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int
forall a. Enum a => a -> a
succ Int
r then ([TokenLC i], [TokenLC i])
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
forall a b. b -> Either a b
Right ([TokenLC i
c], [TokenLC i]
xs') else Int
-> Int
-> [TokenLC i]
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
g Int
l (Int -> Int
forall a. Enum a => a -> a
succ Int
r) [TokenLC i]
xs'
            | Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
leftb = if Int -> Int
forall a. Enum a => a -> a
succ Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r then ([TokenLC i], [TokenLC i])
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
forall a b. b -> Either a b
Right ([TokenLC i
c], [TokenLC i]
xs') else Int
-> Int
-> [TokenLC i]
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
g (Int -> Int
forall a. Enum a => a -> a
succ Int
l) Int
r [TokenLC i]
xs'
            | Bool
otherwise = Int
-> Int
-> [TokenLC i]
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
g Int
l Int
r [TokenLC i]
xs'
            where
                g :: Int
-> Int
-> [TokenLC i]
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
g = (([TokenLC i] -> Either (TokenLC i) ([TokenLC i], [TokenLC i]))
 -> [TokenLC i] -> Either (TokenLC i) ([TokenLC i], [TokenLC i]))
-> (Int
    -> [TokenLC i] -> Either (TokenLC i) ([TokenLC i], [TokenLC i]))
-> Int
-> [TokenLC i]
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ((([TokenLC i], [TokenLC i]) -> ([TokenLC i], [TokenLC i]))
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([TokenLC i] -> [TokenLC i])
-> ([TokenLC i], [TokenLC i]) -> ([TokenLC i], [TokenLC i])
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first ((TokenLCNums i
p, Text -> Token i
forall i. Text -> Token i
HT.TKReserved Text
x)TokenLC i -> [TokenLC i] -> [TokenLC i]
forall a. a -> [a] -> [a]
:)) (Either (TokenLC i) ([TokenLC i], [TokenLC i])
 -> Either (TokenLC i) ([TokenLC i], [TokenLC i]))
-> ([TokenLC i] -> Either (TokenLC i) ([TokenLC i], [TokenLC i]))
-> [TokenLC i]
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Int
  -> [TokenLC i] -> Either (TokenLC i) ([TokenLC i], [TokenLC i]))
 -> Int
 -> [TokenLC i]
 -> Either (TokenLC i) ([TokenLC i], [TokenLC i]))
-> (Int
    -> Int
    -> [TokenLC i]
    -> Either (TokenLC i) ([TokenLC i], [TokenLC i]))
-> Int
-> Int
-> [TokenLC i]
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Int
-> [TokenLC i]
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
f
        f !Int
l !Int
r ((p :: TokenLCNums i
p, x :: Token i
x):xs' :: [TokenLC i]
xs') = ([TokenLC i] -> [TokenLC i])
-> ([TokenLC i], [TokenLC i]) -> ([TokenLC i], [TokenLC i])
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first ((:) (TokenLCNums i
p, Token i
x)) (([TokenLC i], [TokenLC i]) -> ([TokenLC i], [TokenLC i]))
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> Int
-> [TokenLC i]
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
f Int
l Int
r [TokenLC i]
xs'
takeBrace _ _ _ = Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
forall a. Maybe a
Nothing

-- | Get an argument from list of `Htcc.Tokenizer.Token` (e.g: Given the token of @f(g(a, b)), 42@, return the token of @f(g(a, b))@).
readFn :: Eq i => [HT.TokenLC i] -> Maybe ([HT.TokenLC i], [HT.TokenLC i])
readFn :: [TokenLC i] -> Maybe ([TokenLC i], [TokenLC i])
readFn = Int -> Int -> [TokenLC i] -> Maybe ([TokenLC i], [TokenLC i])
forall a a i.
(Eq a, Enum a) =>
a -> a -> [(a, Token i)] -> Maybe ([(a, Token i)], [(a, Token i)])
readFn' 0 (0 :: Int)
    where
        readFn' :: a -> a -> [(a, Token i)] -> Maybe ([(a, Token i)], [(a, Token i)])
readFn' !a
li !a
ri (cur :: (a, Token i)
cur@(_, HT.TKReserved ","):xs :: [(a, Token i)]
xs)
            | a
li a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
ri = ([(a, Token i)], [(a, Token i)])
-> Maybe ([(a, Token i)], [(a, Token i)])
forall a. a -> Maybe a
Just ([], [(a, Token i)]
xs)
            | Bool
otherwise = ([(a, Token i)] -> [(a, Token i)])
-> ([(a, Token i)], [(a, Token i)])
-> ([(a, Token i)], [(a, Token i)])
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first ((a, Token i)
cur(a, Token i) -> [(a, Token i)] -> [(a, Token i)]
forall a. a -> [a] -> [a]
:) (([(a, Token i)], [(a, Token i)])
 -> ([(a, Token i)], [(a, Token i)]))
-> Maybe ([(a, Token i)], [(a, Token i)])
-> Maybe ([(a, Token i)], [(a, Token i)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> a -> [(a, Token i)] -> Maybe ([(a, Token i)], [(a, Token i)])
readFn' a
li a
ri [(a, Token i)]
xs
        readFn' !a
li !a
ri (cur :: (a, Token i)
cur@(_, HT.TKReserved ")"):xs :: [(a, Token i)]
xs)
            | a
li a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
ri = ([(a, Token i)], [(a, Token i)])
-> Maybe ([(a, Token i)], [(a, Token i)])
forall a. a -> Maybe a
Just ([], [(a, Token i)]
xs)
            | Bool
otherwise = ([(a, Token i)] -> [(a, Token i)])
-> ([(a, Token i)], [(a, Token i)])
-> ([(a, Token i)], [(a, Token i)])
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first ((a, Token i)
cur(a, Token i) -> [(a, Token i)] -> [(a, Token i)]
forall a. a -> [a] -> [a]
:) (([(a, Token i)], [(a, Token i)])
 -> ([(a, Token i)], [(a, Token i)]))
-> Maybe ([(a, Token i)], [(a, Token i)])
-> Maybe ([(a, Token i)], [(a, Token i)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> a -> [(a, Token i)] -> Maybe ([(a, Token i)], [(a, Token i)])
readFn' a
li (a -> a
forall a. Enum a => a -> a
succ a
ri) [(a, Token i)]
xs
        readFn' !a
li !a
ri (cur :: (a, Token i)
cur@(_, HT.TKReserved "("):xs :: [(a, Token i)]
xs) = ([(a, Token i)] -> [(a, Token i)])
-> ([(a, Token i)], [(a, Token i)])
-> ([(a, Token i)], [(a, Token i)])
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first ((a, Token i)
cur(a, Token i) -> [(a, Token i)] -> [(a, Token i)]
forall a. a -> [a] -> [a]
:) (([(a, Token i)], [(a, Token i)])
 -> ([(a, Token i)], [(a, Token i)]))
-> Maybe ([(a, Token i)], [(a, Token i)])
-> Maybe ([(a, Token i)], [(a, Token i)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> a -> [(a, Token i)] -> Maybe ([(a, Token i)], [(a, Token i)])
readFn' (a -> a
forall a. Enum a => a -> a
succ a
li) a
ri [(a, Token i)]
xs
        readFn' !a
li !a
ri []
            | a
li a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
ri = ([(a, Token i)], [(a, Token i)])
-> Maybe ([(a, Token i)], [(a, Token i)])
forall a. a -> Maybe a
Just ([], [])
            | Bool
otherwise = Maybe ([(a, Token i)], [(a, Token i)])
forall a. Maybe a
Nothing
        readFn' !a
li !a
ri (x :: (a, Token i)
x:xs :: [(a, Token i)]
xs) = ([(a, Token i)] -> [(a, Token i)])
-> ([(a, Token i)], [(a, Token i)])
-> ([(a, Token i)], [(a, Token i)])
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first ((a, Token i)
x(a, Token i) -> [(a, Token i)] -> [(a, Token i)]
forall a. a -> [a] -> [a]
:) (([(a, Token i)], [(a, Token i)])
 -> ([(a, Token i)], [(a, Token i)]))
-> Maybe ([(a, Token i)], [(a, Token i)])
-> Maybe ([(a, Token i)], [(a, Token i)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> a -> [(a, Token i)] -> Maybe ([(a, Token i)], [(a, Token i)])
readFn' a
li a
ri [(a, Token i)]
xs

-- | Get arguments from list of `Htcc.Tokenizer.Token` (e.g: Given the token of @f(f(g(a, b)), 42);@,
-- return expressions that are the token of "f(g(a, b))" and the token of "42".
takeExps :: Eq i => [HT.TokenLC i] -> Maybe [[HT.TokenLC i]]
takeExps :: [TokenLC i] -> Maybe [[TokenLC i]]
takeExps ((_, HT.TKReserved "("):xs :: [TokenLC i]
xs) = Maybe [[TokenLC i]]
-> Maybe [TokenLC i]
-> ([TokenLC i] -> Maybe [[TokenLC i]])
-> Maybe [[TokenLC i]]
forall b a. b -> Maybe a -> (a -> b) -> b
maybe' Maybe [[TokenLC i]]
forall a. Maybe a
Nothing ((TokenLC i -> Bool) -> [TokenLC i] -> Maybe [TokenLC i]
forall a. (a -> Bool) -> [a] -> Maybe [a]
lastInit ((Token i -> Token i -> Bool
forall a. Eq a => a -> a -> Bool
==Text -> Token i
forall i. Text -> Token i
HT.TKReserved ")") (Token i -> Bool) -> (TokenLC i -> Token i) -> TokenLC i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenLC i -> Token i
forall a b. (a, b) -> b
snd) [TokenLC i]
xs) (([TokenLC i] -> Maybe [[TokenLC i]]) -> Maybe [[TokenLC i]])
-> ([TokenLC i] -> Maybe [[TokenLC i]]) -> Maybe [[TokenLC i]]
forall a b. (a -> b) -> a -> b
$ ([[TokenLC i]] -> [[TokenLC i]])
-> Maybe [[TokenLC i]] -> Maybe [[TokenLC i]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([TokenLC i] -> Bool) -> [[TokenLC i]] -> [[TokenLC i]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([TokenLC i] -> Bool) -> [TokenLC i] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TokenLC i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)) (Maybe [[TokenLC i]] -> Maybe [[TokenLC i]])
-> ([TokenLC i] -> Maybe [[TokenLC i]])
-> [TokenLC i]
-> Maybe [[TokenLC i]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TokenLC i] -> Maybe [[TokenLC i]]
forall i. Eq i => [TokenLC i] -> Maybe [[TokenLC i]]
f
    where
        f :: [TokenLC i] -> Maybe [[TokenLC i]]
f []   = [[TokenLC i]] -> Maybe [[TokenLC i]]
forall a. a -> Maybe a
Just []
        f args :: [TokenLC i]
args = Maybe [[TokenLC i]]
-> (([TokenLC i], [TokenLC i]) -> Maybe [[TokenLC i]])
-> Maybe ([TokenLC i], [TokenLC i])
-> Maybe [[TokenLC i]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe [[TokenLC i]]
forall a. Maybe a
Nothing (\(ex :: [TokenLC i]
ex, ds :: [TokenLC i]
ds) -> ([TokenLC i]
ex[TokenLC i] -> [[TokenLC i]] -> [[TokenLC i]]
forall a. a -> [a] -> [a]
:) ([[TokenLC i]] -> [[TokenLC i]])
-> Maybe [[TokenLC i]] -> Maybe [[TokenLC i]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TokenLC i] -> Maybe [[TokenLC i]]
f [TokenLC i]
ds) (Maybe ([TokenLC i], [TokenLC i]) -> Maybe [[TokenLC i]])
-> Maybe ([TokenLC i], [TokenLC i]) -> Maybe [[TokenLC i]]
forall a b. (a -> b) -> a -> b
$ [TokenLC i] -> Maybe ([TokenLC i], [TokenLC i])
forall i. Eq i => [TokenLC i] -> Maybe ([TokenLC i], [TokenLC i])
readFn [TokenLC i]
args
takeExps _ = Maybe [[TokenLC i]]
forall a. Maybe a
Nothing