module Data.BAByNF.ABNF.Parse
    ( parse
    , parseRulelist
    ) where

import Data.List qualified as List

import Data.ByteString (ByteString)

import Data.Attoparsec.ByteString qualified as Attoparsec.ByteString

import Data.BAByNF.Core.Ref qualified as Ref

import Data.BAByNF.Core.Tree (Tree)
import Data.BAByNF.Core.Tree qualified as Tree
import Data.BAByNF.Core.RefDict (RefDict (..))
import Data.BAByNF.Core.Parseable qualified as Parseable
import Data.BAByNF.Core.Parseable (Parseable)
import Data.BAByNF.ABNF.Model qualified as Model
import Data.BAByNF.ABNF.Rules.Rulelist qualified as Rulelist
import Data.BAByNF.ABNF.Rules (rules)
import Data.BAByNF.ABNF.ToParseable

-- TODO: split parse til end of input?

parse :: ToParseable p => Model.Rulelist -> p -> ByteString -> Either String (Tree Model.Rulename)
parse :: forall p.
ToParseable p =>
Rulelist -> p -> ByteString -> Either String (Tree Rulename)
parse Rulelist
r p
p ByteString
t = 
    let parser :: TreeParser Rulename
parser = Dict Rulename -> Parseable Rulename -> TreeParser Rulename
forall a. (Ref a, Show a) => Dict a -> Parseable a -> TreeParser a
Parseable.toParser (Rulelist -> Dict Rulename
toRefDict Rulelist
r) (p -> Parseable Rulename
forall a. ToParseable a => a -> Parseable Rulename
toParseable p
p) 
     in TreeParser Rulename -> ByteString -> Either String (Tree Rulename)
forall a. Parser a -> ByteString -> Either String a
Attoparsec.ByteString.parseOnly TreeParser Rulename
parser ByteString
t

parseRulelist :: ByteString -> Either String Model.Rulelist
parseRulelist :: ByteString -> Either String Rulelist
parseRulelist ByteString
t =
    let toTree :: Either String (Tree Rulename)
toTree = Rulelist -> Rulename -> ByteString -> Either String (Tree Rulename)
forall p.
ToParseable p =>
Rulelist -> p -> ByteString -> Either String (Tree Rulename)
parse Rulelist
rules Rulename
Rulelist.ref ByteString
t
     in Either String (Tree Rulename)
toTree
        Either String (Tree Rulename)
-> (Tree Rulename -> Either String Rulelist)
-> Either String Rulelist
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Tree Rulename
tree -> case Tree Rulename -> [Node Rulename]
forall a. Ref a => Tree a -> [Node a]
Tree.nodes Tree Rulename
tree of
            [Tree.RefNode Rulename
ref Tree Rulename
subtree]
                | Rulename -> Rulename -> Bool
forall a. Ref a => a -> a -> Bool
Ref.eq Rulename
ref Rulename
Rulelist.ref -> Tree Rulename -> Either String (Tree Rulename)
forall a b. b -> Either a b
Right Tree Rulename
subtree
                | Bool
otherwise -> String -> Either String (Tree Rulename)
forall a b. a -> Either a b
Left String
"structural mismatch for <rulelist>"
            [Node Rulename]
_ -> String -> Either String (Tree Rulename)
forall a b. a -> Either a b
Left String
"structural mismatch for <rulelist>"
        Either String (Tree Rulename)
-> (Tree Rulename -> Either String Rulelist)
-> Either String Rulelist
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either [String] Rulelist -> Either String Rulelist
forall {b}. Either [String] b -> Either String b
joinErrors (Either [String] Rulelist -> Either String Rulelist)
-> (Tree Rulename -> Either [String] Rulelist)
-> Tree Rulename
-> Either String Rulelist
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree Rulename -> Either [String] Rulelist
Rulelist.fromTree
     where joinErrors :: Either [String] b -> Either String b
joinErrors (Right b
x) = b -> Either String b
forall a b. b -> Either a b
Right b
x
           joinErrors (Left [String]
errors) = String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$ String
"Errors found:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"\n" [String]
errors

toRefDict :: Model.Rulelist -> RefDict Model.Rulename (Parseable Model.Rulename)
toRefDict :: Rulelist -> Dict Rulename
toRefDict (Model.Rulelist [Rule]
r) = [(Rulename, Parseable Rulename)] -> Dict Rulename
forall a b. Ref a => [(a, b)] -> RefDict a b
RefDict ((Rule -> (Rulename, Parseable Rulename))
-> [Rule] -> [(Rulename, Parseable Rulename)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Model.Rule Rulename
ref DefinedAs
_ (Model.Elements Alternation
a)) -> (Rulename
ref, Alternation -> Parseable Rulename
forall a. ToParseable a => a -> Parseable Rulename
toParseable Alternation
a)) [Rule]
r)