Fix description.

[haskell/symantic.git] / symantic-grammar / Language / Symantic / Grammar / Test.hs

diff --git a/symantic-grammar/Language/Symantic/Grammar/Test.hs b/symantic-grammar/Language/Symantic/Grammar/Test.hs
index a620e1905537a79fc6d817aae6a86dadbb244147..67f48ada4a5d2a7e476e4ad9c17fa1a3c0b03d5d 100644 (file)
--- a/symantic-grammar/Language/Symantic/Grammar/Test.hs
+++ b/symantic-grammar/Language/Symantic/Grammar/Test.hs
@@ -6,15 +6,13 @@ import Test.Tasty
 import Test.Tasty.HUnit
 
 import Control.Applicative (Applicative(..))
-import qualified Control.Applicative as Alt
 import Control.Monad
-import qualified Data.Char as Char
-import Data.Functor.Identity
-import qualified Data.List as List
-import Data.Monoid ((<>))
+import Data.Semigroup ((<>))
 import Data.String (IsString(..))
-import qualified Data.Text as Text
 import Prelude hiding (any, (^), exp)
+import qualified Control.Applicative as Gram_AltApp
+import qualified Data.Char as Char
+import qualified Data.Text as Text
 import qualified Text.Megaparsec as P
 
 import Language.Symantic.Grammar
@@ -30,48 +28,41 @@ instance ParsecC e s => Gram_Terminal (P.ParsecT e s m) where
        eoi          = P.eof
        char         = P.char
        string       = P.string
-       unicat cat   = P.satisfy $ (`List.elem` cats) . Char.generalCategory
+       unicat cat   = P.satisfy $ (`elem` cats) . Char.generalCategory
                where cats = unicode_categories cat
        range (l, h) = P.satisfy $ \c -> l <= c && c <= h
        but (Terminal f) (Terminal p) = Terminal $ P.notFollowedBy (P.try p) *> f
-instance ParsecC e s => Alter (P.ParsecT e s m) where
-       empty = Alt.empty
-       x <+> y = P.try x Alt.<|> y
+instance ParsecC e s => Gram_Alt (P.ParsecT e s m) where
+       empty  = Gram_AltApp.empty
+       (<+>)  = (Gram_AltApp.<|>)
+       choice = P.choice
+instance ParsecC e s => Gram_Try (P.ParsecT e s m) where
+       try = P.try
 instance ParsecC e s => Gram_RegR (P.ParsecT e s m) where
        Terminal f .*> Reg x = Reg $ f <*> x
 instance ParsecC e s => Gram_RegL (P.ParsecT e s m) where
        Reg f <*. Terminal x = Reg $ f <*> x
-instance ParsecC e s => App (P.ParsecT e s m)
-instance ParsecC e s => Alt (P.ParsecT e s m)
+instance ParsecC e s => Gram_App (P.ParsecT e s m)
+instance ParsecC e s => Gram_AltApp (P.ParsecT e s m)
 instance ParsecC e s => Gram_CF (P.ParsecT e s m) where
-       CF f <& Reg p        = CF $ P.lookAhead f <*> p
-       Reg f &> CF p        = CF $ P.lookAhead f <*> p
-       minus (CF f) (Reg p) = CF $ P.notFollowedBy (P.try p) *> f
+       CF f <& Reg p      = CF $ P.lookAhead f <*> p
+       Reg f &> CF p      = CF $ P.lookAhead f <*> p
+       CF f `minus` Reg p = CF $ P.notFollowedBy (P.try p) *> f
 instance ParsecC e s => Gram_Meta P.SourcePos (P.ParsecT e s m) where
-       metaG p = do
+       withMeta p = do
                pos <- P.getPosition
                ($ pos) <$> p
-instance ParsecC e s => Gram_Lexer (P.ParsecT e s m)
-
-runParserT :: Monad m
- => P.ParsecT P.Dec s m a -> s
- -> m (Either (P.ParseError (P.Token s) P.Dec) a)
-runParserT p = P.runParserT p ""
-
-runParser
- :: P.ParsecT P.Dec s Identity a -> s
- -> Either (P.ParseError (P.Token s) P.Dec) a
-runParser p = P.runParser p ""
+instance ParsecC e s => Gram_Comment (P.ParsecT e s m)
 
-elide :: String -> String
-elide s | length s > 42 = take 42 s ++ ['…']
-elide s = s
+elide :: Text.Text -> String
+elide s | Text.length s > 42 = take 42 (Text.unpack s) <> ['…']
+elide s = Text.unpack s
 
 tests :: TestTree
 tests = testGroup "Grammar"
  [ testGroup "Terminal" $
        let (==>) inp exp =
-               testCase (elide $ Text.unpack exp) $
+               testCase (elide exp) $
                runEBNF (unTerminal (void inp)) @?= exp
                ; infix 1 ==> in
         [ string "" ==> "\"\""
@@ -83,7 +74,7 @@ tests = testGroup "Grammar"
         ]
  , testGroup "Reg" $
        let (==>) inp exp =
-               testCase (elide $ Text.unpack exp) $
+               testCase (elide exp) $
                runEBNF (unReg (void inp)) @?= exp
                ; infix 1 ==> in
         [ (<>) <$> string "0" .*> someR (char '1') ==> "\"0\", {\"1\"}-"
@@ -91,7 +82,7 @@ tests = testGroup "Grammar"
         ]
  , testGroup "CF" $
        let (==>) inp exp =
-               testCase (elide $ Text.unpack exp) $
+               testCase (elide exp) $
                runEBNF (unCF (void inp)) @?= exp
                ; infix 1 ==> in
         [ (<>) <$> string "0" <*> string "1" ==> "\"0\", \"1\""
@@ -107,9 +98,9 @@ tests = testGroup "Grammar"
                 ] <*> string "5" ==> "(\"0\", \"1\" | \"2\" | \"3\" | \"4\"), \"5\""
         , concat <$> many (string "0") ==> "{\"0\"}"
         , () <$ char 'a' <* char 'b' <* char 'c' ==> "\"a\", \"b\", \"c\""
-        ,let g0  = (<>) <$> string "0" .*> someR (char '1') in
+        ,let g0 = (<>) <$> string "0" .*> someR (char '1') in
                (<>) <$> string "0" <& g0 ==> "\"0\" & \"0\", {\"1\"}-"
-        ,let g0  = (<>) <$> string "0" .*> someR (char '1') in
+        ,let g0 = (<>) <$> string "0" .*> someR (char '1') in
                let g1 = (<>) <$> someL (char '1') <*. string "0" in
                string "0" `minus` g0 `minus` g1 ==>
                "\"0\" - \"0\", {\"1\"}- - {\"1\"}-, \"0\""