- Earley-0.10.1.0

{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}

module SymbolicDifferentiation.EarleySpec where

import SymbolicDifferentiation.AlphaSyntax (Exp(N, V, Plus, Times))
import qualified SymbolicDifferentiation.Earley as Earley
import Text.Earley (Report(..))

import Test.Hspec (Spec, hspec, describe, it, shouldBe, shouldSatisfy)
import Test.Hspec.QuickCheck (prop)
import Test.QuickCheck (NonNegative(..))

import Data.String.Here (i)

spec :: Spec
spec =
  describe "Custom syntax for expression parsed by Earley" $ do
    -- For simplicity, don't support negative numeric literals now.
    prop "x + a" $ \(NonNegative (a :: Int)) ->
      fst (Earley.parses [i|x + ${a}|]) `shouldBe`
        [Plus (V "x") (N a)]

    prop "x*a + y*b * (z+c)" $
      \(NonNegative (a :: Int))
       (NonNegative (b :: Int))
       (NonNegative (c :: Int)) ->
      fst (Earley.parses [i|x*${a} + y*${b} * (z+${c})|]) `shouldBe`
        [Plus (Times (V "x") (N a))
              (Times (Times (V "y") (N b))
                     (Plus (V "z") (N c)))]

    it "x + y * + 5" $
      Earley.parses "x + y * + 5" `shouldSatisfy`
        \case
          ([], Report { position = 8
                      , expected = ["number", "identifier", "("]
                      , unconsumed = "+ 5"
                      }) -> True
          _ -> False

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE FlexibleContexts #-}

module SymbolicDifferentiation.Earley where

import SymbolicDifferentiation.AlphaSyntax (Exp(N, V, Plus, Times))

import qualified Text.Earley as E
import Text.Earley ((<?>))
import Control.Applicative (many, some, (<|>))
import qualified Data.Char as Char
import Control.Monad.ST (ST)
import Data.ListLike (ListLike)

-- | What to report for something expected.
type Expected = String

-- | Return a list of all possible `Exp` parses, and also a status report
-- regardless of how many successes.
parses :: String -> ([Exp], E.Report Expected String)
parses = E.fullParses expParser

-- | Parser created from the grammar.
expParser :: ListLike input Char =>
             ST state (input -> ST state (E.Result state Expected input Exp))
expParser = E.parser grammar

-- | Basically taken from <https://github.com/ollef/Earley/blob/master/examples/Expr2.hs Earley example expression parser>
grammar :: forall r. E.Grammar r (E.Prod r Expected Char Exp)
grammar = mdo
  whitespace <- E.rule $
    many $ E.satisfy Char.isSpace

  let token :: E.Prod r Expected Char a -> E.Prod r Expected Char a
      token p = whitespace *> p

      sym x   = token $ E.symbol x <?> [x]

      ident   = token $ (:) <$> E.satisfy Char.isAlpha
                            <*> many (E.satisfy Char.isAlphaNum)
                            <?> "identifier"
      num     = token $ some (E.satisfy Char.isDigit) <?> "number"
      -- For now, just handle unsigned numeric literals.

  atom <- E.rule $
    (N . read) <$> num
    <|> V <$> ident
    <|> sym '(' *> term <* sym ')'

  factor <- E.rule $
    Times <$> factor <* sym '*' <*> atom
    <|> atom

  term <- E.rule $
    Plus <$> term <* sym '+' <*> factor
    <|> factor

  return $ term <* whitespace

module EarleyExampleSpec where

import EarleyExample (grammar, NumberWord, Expected)
import qualified Text.Earley as E
import qualified Data.List.NonEmpty as NonEmpty

import Test.Hspec (Spec, hspec, describe, it, shouldMatchList)

spec :: Spec
spec =
  describe "EarleyExample" $ do
    it "returns all possible parses of number words" $ do
      let (result, _) = parseNumberWord 1234
      map NonEmpty.toList result `shouldMatchList`
        ["ABCD", "AWD", "LCD"]

parseNumberWord :: Integer -> ([NumberWord], E.Report Expected String)
parseNumberWord = E.fullParses (E.parser grammar) . show

{-# LANGUAGE RecursiveDo #-}

module EarleyExample where

import qualified Text.Earley as E
import Text.Earley ((<?>))
import Control.Applicative ((<|>))
import qualified Data.Foldable as Foldable
import qualified Data.Char as Char
import qualified Data.List.NonEmpty as NonEmpty
import Data.List.NonEmpty (NonEmpty((:|)))

-- | Result wanted.
type NumberWord = NonEmpty NumberLetter

-- | 'A' to 'Z'.
type NumberLetter = Char

-- | What to report for something expected.
type Expected = String

grammar :: E.Grammar r (E.Prod r Expected Char NumberWord)
grammar = mdo
  numberWord <- E.rule $
    NonEmpty.cons <$> numberLetter <*> numberWord
    <|> (:| []) <$> numberLetter
  return numberWord

numberLetter :: E.Prod r Expected Char NumberLetter
numberLetter = (Foldable.asum . map numberLetterFor) ['A'..'Z'] <?> "number"

-- | Return a production for a given letter.
--
-- 1 is 'A', 2 is 'B', .. 26 is 'Z'.
numberLetterFor :: NumberLetter -> E.Prod r Expected Char NumberLetter
numberLetterFor c = c <$ E.word (show (toNumber c)) <?> [c]

-- | 'A' is 1, ... 'Z' is 26
toNumber :: NumberLetter -> Int
toNumber c = (Char.ord c - Char.ord 'A') + 1