{-# LANGUAGE
StrictData #-}
module Little.Earley.Internal.Result where
import Data.Foldable (minimumBy)
import Data.Ord (comparing)
import Little.Earley.Internal.Core
import Little.Earley.Internal.Tree
import Little.Earley.Internal.Pretty
import Little.Earley.Internal.Render
data Result n t c
= ParseError
| ParseSuccess (ParsedResult n t c)
data ParsedResult n t c = ParsedResult
{ ParsedResult n t c -> TreeSet n t c
prParseTree :: TreeSet n t c
, ParsedResult n t c -> [LocAmbiguity n t c]
prAmbiguities :: [LocAmbiguity n t c]
}
instance (PrettyPrint n, PrettyPrint c) => PrettyPrint (Result n t c) where
prettyPrint :: Result n t c -> String
prettyPrint Result n t c
ParseError = String
"Parse error"
prettyPrint (ParseSuccess ParsedResult n t c
r) = [String] -> String
unlines ([String]
pTree [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
pAmbig) where
pTree :: [String]
pTree = Tree n t c -> [String]
forall n c t.
(PrettyPrint n, PrettyPrint c) =>
Tree n t c -> [String]
prettyTree (TreeSet n t c -> Tree n t c
forall n t c. TreeSet n t c -> Tree n t c
arbTree (ParsedResult n t c -> TreeSet n t c
forall n t c. ParsedResult n t c -> TreeSet n t c
prParseTree ParsedResult n t c
r))
pAmbig :: [String]
pAmbig = case ParsedResult n t c -> [LocAmbiguity n t c]
forall n t c. ParsedResult n t c -> [LocAmbiguity n t c]
prAmbiguities ParsedResult n t c
r of
[] -> []
[LocAmbiguity n t c]
ambs ->
let (Range
rg, Ambiguity Tree n t c
t1 Tree n t c
t2) = (LocAmbiguity n t c -> LocAmbiguity n t c -> Ordering)
-> [LocAmbiguity n t c] -> LocAmbiguity n t c
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy ((LocAmbiguity n t c -> Range)
-> LocAmbiguity n t c -> LocAmbiguity n t c -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing LocAmbiguity n t c -> Range
forall a b. (a, b) -> a
fst) (Int -> [LocAmbiguity n t c] -> [LocAmbiguity n t c]
forall a. Int -> [a] -> [a]
take Int
1000 [LocAmbiguity n t c]
ambs)
pRange :: String
pRange = String
"Ambiguous parse between tokens number "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Range -> Int
rangePos Range
rg) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" and " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Range -> Int
rangePos Range
rg Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Range -> Int
rangeLen Range
rg) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" in
String
"" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
pRange String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Tree n t c -> [String]
forall n c t.
(PrettyPrint n, PrettyPrint c) =>
Tree n t c -> [String]
prettyTree Tree n t c
t1 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String
"" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Tree n t c -> [String]
forall n c t.
(PrettyPrint n, PrettyPrint c) =>
Tree n t c -> [String]
prettyTree Tree n t c
t2
parse :: (Ord n, Ord t) => Grammar n t c -> n -> [c] -> Result n t c
parse :: Grammar n t c -> n -> [c] -> Result n t c
parse Grammar n t c
g n
n [c]
cs =
case Grammar n t c -> n -> [c] -> Maybe (TreeSet n t c)
forall n t c.
(Ord n, Ord t) =>
Grammar n t c -> n -> [c] -> Maybe (TreeSet n t c)
parseTreeSet Grammar n t c
g n
n [c]
cs of
Maybe (TreeSet n t c)
Nothing -> Result n t c
forall n t c. Result n t c
ParseError
Just TreeSet n t c
t -> ParsedResult n t c -> Result n t c
forall n t c. ParsedResult n t c -> Result n t c
ParseSuccess (ParsedResult :: forall n t c.
TreeSet n t c -> [LocAmbiguity n t c] -> ParsedResult n t c
ParsedResult
{ prParseTree :: TreeSet n t c
prParseTree = TreeSet n t c
t
, prAmbiguities :: [LocAmbiguity n t c]
prAmbiguities = Int -> Int -> TreeSet n t c -> [LocAmbiguity n t c]
forall n t c. Int -> Int -> TreeSet n t c -> [LocAmbiguity n t c]
ambiguities Int
0 ([c] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [c]
cs) TreeSet n t c
t
})
pparse :: (Ord n, Ord t) => Grammar n t c -> n -> [c] -> Pretty (Result n t c)
pparse :: Grammar n t c -> n -> [c] -> Pretty (Result n t c)
pparse Grammar n t c
g n
n [c]
cs = Result n t c -> Pretty (Result n t c)
forall a. a -> Pretty a
Pretty (Grammar n t c -> n -> [c] -> Result n t c
forall n t c.
(Ord n, Ord t) =>
Grammar n t c -> n -> [c] -> Result n t c
parse Grammar n t c
g n
n [c]
cs)