{-# 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

-- | Result of 'parse'.
data Result n t c
  = ParseError
  | ParseSuccess (ParsedResult n t c)

-- | Successful result of 'parse'.
data ParsedResult n t c = ParsedResult
  { ParsedResult n t c -> TreeSet n t c
prParseTree :: TreeSet n t c
    -- ^ The resulting parse tree.
  , ParsedResult n t c -> [LocAmbiguity n t c]
prAmbiguities :: [LocAmbiguity n t c]
    -- ^ A stream of localized ambiguities, when the parse tree is ambiguous.
  }

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 a chain of tokens @[c]@ given a grammar and a starting symbol @n@.
--
-- == Example
--
-- @
-- 'parse' arithG SUM \"1+2*3\"
-- @
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
      })

-- | Wrapped 'parse' with a pretty-printed result. Use this in the REPL.
--
-- == Example
--
-- @
-- 'pparse' arithG SUM \"1+2*3\"
-- @
--
-- Output:
--
-- >      +-----+--SUM #1---+
-- >      |     |           |
-- >   SUM #0   |      +PRODUCT #1-+
-- >      |     |      |     |     |
-- > PRODUCT #0 | PRODUCT #0 |     |
-- >      |     |      |     |     |
-- >  FACTOR #0 |  FACTOR #0 | FACTOR #0
-- >      |     |      |     |     |
-- >  NUMBER #0 |  NUMBER #0 | NUMBER #0
-- >      |     |      |     |     |
-- > -----------------------------------
-- >      1     +      2     *     3
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)