penntreebank-megaparsec 0.1.0 → 0.2.0

raw patch · 6 files changed

+320/−19 lines, 6 filesdep +template-haskellPVP ok

version bump matches the API change (PVP)

Dependencies added: template-haskell

API changes (from Hackage documentation)

Files

• penntreebank-megaparsec.cabal +5/−2
• src/Data/Tree/Parser/Penn/Megaparsec/Char.hs +106/−6
• src/Data/Tree/Parser/Penn/Megaparsec/Char/QQ.hs +104/−0
• src/Data/Tree/Parser/Penn/Megaparsec/Internal.hs +13/−4
• src/Text/PennTreebank/Parser/Megaparsec/Char.hs +56/−6
• test/unit/Data/Tree/Parser/Penn/Megaparsec/CharSpec.hs +36/−1

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 51655472fc364cb3aeec7d393dc61d5a63bc39a28b01833e78f57bec3545b7c8+-- hash: 036bc4d19d0a78ab78a47028866e8797551bb1f1cae0234cec98bc3809355351  name:           penntreebank-megaparsec-version:        0.1.0+version:        0.2.0 synopsis:       Parser combinators for trees in the Penn Treebank format description:    This Haskell package provides parsers for syntactic trees annotated                  in the Penn Treebank format, powered by Megaparsec.@@ -31,6 +31,7 @@ library   exposed-modules:       Data.Tree.Parser.Penn.Megaparsec.Char+      Data.Tree.Parser.Penn.Megaparsec.Char.QQ       Data.Tree.Parser.Penn.Megaparsec.Internal       Text.PennTreebank.Parser.Megaparsec.Char   other-modules:@@ -42,6 +43,7 @@     , containers >=0.5 && <0.7     , megaparsec >=8.0 && <9     , mtl >=2.2.2 && <3+    , template-haskell >=2.13 && <3     , transformers >=0.4 && <0.6   default-language: Haskell2010 @@ -63,6 +65,7 @@     , megaparsec >=8.0 && <9     , mtl >=2.2.2 && <3     , penntreebank-megaparsec+    , template-haskell >=2.13 && <3     , text >=0.2 && <1.3     , transformers >=0.4 && <0.6   default-language: Haskell2010

@@ -11,14 +11,19 @@ -}  {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ScopedTypeVariables #-}  module Data.Tree.Parser.Penn.Megaparsec.Char (+    -- * Type Classes for Node Parsers+    ParsableAsTerm(..),+    UnsafelyParsableAsTerm(..),+     -- * Parsers     pTree,-    ParsableAsTerm(..),+    pUnsafeTree,      -- * Parser Type Synonyms     PennTreeParserT,@@ -35,7 +40,7 @@     runParserT' ) where -import Data.Char as DCh+import Data.Char (isSpace) import Data.Tree import Data.Void (Void) import Data.Proxy (Proxy(..))@@ -50,6 +55,40 @@  import Data.Tree.Parser.Penn.Megaparsec.Internal     +{-|+    A type class for node label types @term@ +    data of which can be obtained by parsing a stream of type @str@+    that is supposed to be embedded into the parser+    'Data.Tree.Parser.Penn.Megaparsec.Char.pUnsafeTree'.+    It is your own responsibility to avoid these parsers to crash+        by letting them unintendedly consume +        symbols preserved for tree node demarcation+        (e.g. parentheses and spaces).+    +    @since 0.1.1+-}+class (Stream str) => UnsafelyParsableAsTerm str term where+    {-|+        A parser for non-terminal node labels.+    -}+    pUnsafeNonTerm :: (Ord err) => ParsecT err str m term++    {-|+        A parser for terminal node labels.+        This parser may not comsume empty inputs,+            for otherwise parsing will fall into infinte recursion.+    -}+    pUnsafeTerm :: (Ord err) => ParsecT err str m term++instance (Stream str, Tokens str ~ term, Token str ~ Char)+    => UnsafelyParsableAsTerm str term where+    pUnsafeNonTerm +        = takeWhileP (Just "Non-Terminal Label")+            (\c -> c /= '(' && c /= ')' && not (isSpace c))+    pUnsafeTerm+        = takeWhile1P (Just "Terminal Label")+            (\c -> c /= '(' && c /= ')' && not (isSpace c))+ -- | A parser (monad transformer) that consumes spaces. spaceConsumer :: (MonadParsec err str m, Token str ~ Char) => m () spaceConsumer@@ -82,7 +121,7 @@ invokeLabelParserRaw      = takeWhile1P         (Just "Literal String")-        (\x -> x /= '(' && x /= ')' && not (DCh.isSpace x))+        (\x -> x /= '(' && x /= ')' && not (isSpace x))  {-|     A vertial parser (monad transformer) compositor that @@ -105,6 +144,7 @@             forM_ errors registerParseError             return undefined         Right label -> return label+ {-|     A parser (parser monad transformer) for trees in the Penn Treebank format,         where @err@ is the type of custom errors,@@ -112,8 +152,11 @@         @m@ is the type of the undelying monad and         @term@ is the type of node labels. -    This parser will do a secondary parse for node labels (of type @term@).-    The secondary node label parser is designated by+    This parser will do a preliminary parse for +        node labels as raw strings of type @str@.+    The carved strings will contain no spaces or parentheses.+    A seconsary parsing will take place on the spot+        the way of parsing of which is designated by you         specifying the type @term@ as an instance of 'ParsableAsTerm'.          This parser accepts various types of text stream,@@ -123,7 +166,6 @@          > (pTree :: ParsecT Void Text Identity (Tree Text)) -}- pTree ::     (         Ord err,@@ -177,6 +219,64 @@                 }                 invokeLabelParser pTerm substate             return $ Node labelParsed []++{-|+    Another parser for trees in the Penn Treebank format,+        where @err@ is the type of custom errors,+        @str@ is the type of the stream,+        @m@ is the type of the undelying monad and+        @term@ is the type of node labels.++    Apart from 'pTree', you can customize node label parsers+        in a more liberal way +        by specifying the type @term@ +        as an instance of 'UnsafelyParsableAsTerm'.+    You can let parsers consume spaces and parentheses+        (perhaps with quotation markers) +        unless they do not broke the parsing of the whole trees.+    It is all your responsibility to make sure of it.+    +    This parser accepts various types of text stream,+        including 'String', 'Data.Text.Text' and 'Data.Text.Lazy.Text'.+    You might need to manually annotate the type of this parser+        to specify what type of stream you target at in the following way:+    +    > (pUnsafeTree :: ParsecT Void Text Identity (Tree Text))++    @since 0.1.1+-}+pUnsafeTree ::+    (+        Ord err,+        UnsafelyParsableAsTerm str term,+        Monad m,+        Token str ~ Char,+        Tokens str ~ str+    ) => ParsecT err str m (Tree term)+pUnsafeTree+    = pParens pTreeInside <|> pTerminalNode <?> "Parsed Tree"+    where +        pTreeInside :: forall str. forall err. forall m. forall term.  (+                Ord err,+                UnsafelyParsableAsTerm str term,+                Monad m,+                Token str ~ Char,+                Tokens str ~ str+            ) => ParsecT err str m (Tree term)+        pTreeInside +            = Node +                <$> lexer pUnsafeNonTerm+                <*> (many $ lexer pUnsafeTree)+            +        pTerminalNode :: (+                Ord err,+                UnsafelyParsableAsTerm str term,+                Monad m,+                Token str ~ Char,+                Tokens str ~ str+            ) => ParsecT err str m (Tree term)+        pTerminalNode +            = Node <$> lexer pUnsafeTerm <*> pure []  type PennTreeParserT str m term = ParsecT Void str m (Tree term) type PennTreeParser str term = PennTreeParserT str Identity term

@@ -0,0 +1,104 @@+{-|+    Module          : Data.Tree.Parser.Penn.Megaparsec+    Description     : Quasiquoters that quotes strings representation of treebank trees.+    Copyright       : (c) 2020 Nori Hayashi+    License         : BSD3+    Maintainer      : Nori Hayashi <net@hayashi-lin.net>+    Stability       : experimental+    Portability     : portable+    Language        : Haskell2010+-}++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}++module Data.Tree.Parser.Penn.Megaparsec.Char.QQ (+    pennTreeQQ+    , penn+    , pennTreeUnsafeQQ+    , pennUnsafe+) where++import Language.Haskell.TH+import Language.Haskell.TH.Syntax+import Language.Haskell.TH.Quote+import Text.Megaparsec+import qualified Text.Megaparsec.Char as MC++import Data.Tree+import Data.Tree.Parser.Penn.Megaparsec.Char++instance (Lift a) => Lift (Tree a) where+    lift (Node root children) = do+        qRoot <- lift root+        qChildren <- mapM lift children+        return $ (ConE 'Node) +            `AppE` qRoot+            `AppE` (ListE qChildren)++pennTreeQQ :: +    forall a. (ParsableAsTerm String a, Lift a) +    => QuasiQuoter+pennTreeQQ = QuasiQuoter+    {+        quoteDec = error "Exp quoter only"+        , quoteExp = expQ+        , quotePat = error "Dec quoter only"+        , quoteType = error "Dec quoter only"+    }+    where+        parser :: PennTreeParser String a+        parser = do+            MC.space+            tree <- pTree+            MC.space+            eof+            return tree+        expQ :: String -> Q Exp+        expQ str = do+            let pres = parse +                        parser+                        "Haskell QuasiQuote"+                        str +            case pres of +                Left errbundle -> do+                    reportError $ errorBundlePretty errbundle+                    return undefined+                Right t -> lift t++penn = pennTreeQQ++pennTreeUnsafeQQ :: +    forall a. (UnsafelyParsableAsTerm String a, Lift a) +    => QuasiQuoter+pennTreeUnsafeQQ = QuasiQuoter+    {+        quoteDec = error "Exp quoter only"+        , quoteExp = expQ+        , quotePat = error "Dec quoter only"+        , quoteType = error "Dec quoter only"+    }+    where+        parser :: PennTreeParser String a+        parser = do+            MC.space+            tree <- pUnsafeTree+            MC.space+            eof+            return tree+        expQ :: String -> Q Exp+        expQ str = do+            let pres = parse +                        parser+                        "Haskell QuasiQuote"+                        str +            case pres of +                Left errbundle -> do+                    reportError $ errorBundlePretty errbundle+                    return undefined+                Right t -> lift t++pennUnsafe = pennTreeUnsafeQQ

@@ -15,24 +15,33 @@ {-# LANGUAGE TypeFamilies #-}  module Data.Tree.Parser.Penn.Megaparsec.Internal (-    ParsableAsTerm(..)+    ParsableAsTerm(..), ) where  import Text.Megaparsec  {-|     A type class for node label types @term@ -    data of which can be obtained by parsing a stream of type @str@.+    data of which can be obtained by parsing a stream of type @str@+    that is safely carved by the tree parser+    'Data.Tree.Parser.Penn.Megaparsec.Char.pTree'+    containing no spaces and parenthese. -} class (Stream str) => ParsableAsTerm str term where     {-|-        A parser that extracts exactly one token -        of the node label type @term@ from an input stream of type @str@.+        A parser for non-terminal node labels.+        Empty inputs are expected.     -}     pNonTerm :: (Ord err) => ParsecT err str m term++    {-|+        A parser for terminal node labels.+        Empty inputs are not expected.+    -}     pTerm :: (Ord err) => ParsecT err str m term  instance (Stream str, Tokens str ~ term)      => ParsableAsTerm str term where     pNonTerm = takeRest     pTerm = takeRest+

@@ -14,7 +14,12 @@ module Text.PennTreebank.Parser.Megaparsec.Char (     -- * Parser     pDoc,+    pUnsafeDoc, +    -- * Parser Type Synonyms+    PennDocParserT,+    PennDocParser,+     -- * Parser Runners     -- | Re-imported from "Text.Megaparsec".     parse,@@ -65,12 +70,15 @@         @m@ is the type of the undelying monad and         @term@ is the type of node labels. -    This parser will do a secondary parse for node labels,-        results of which are of type @term@.-    Failures are registered to the main tree parsing process.-    The secondary node label parser is designated by-        specifying @term@ as an instance of 'Data.Tree.Parser.Penn.Megaparsec.Internal.ParsableAsTerm'.-    +    This parser invokes +        'Data.Tree.Parser.Penn.Megaparsec.Char.pTree'+        which will do inside an initial parse for +        node labels as raw strings of type @str@.+    A seconsary parsing will take place on the spot+        the way of parsing of which is designated by you+        specifying the type @term@ as an instance of +        'Data.Tree.Parser.Penn.Megaparsec.Internal.ParsableAsTerm'.+     This parser accepts various types of text stream,         including 'String', 'Data.Text.Text' and 'Data.Text.Lazy.Text'.     You might need to manually annotate the type of this parser@@ -90,3 +98,45 @@     doc <- many $ lexer TPC.pTree     eof     return doc++{-|+    Another parser +        for treebank files in the Penn Treebank format+        via 'Data.Tree.Parser.Penn.Megaparsec.Char.pUnsafeTree'.++    This parser will do a secondary parse for node labels,+        results of which are of type @term@.+    You can customize node label parsers+        in a more liberal way +        by specifying the type @term@ +        as an instance of +        'Data.Tree.Parser.Penn.Megaparsec.Char.UnsafelyParsableAsTerm'.+    You can let parsers consume spaces and parentheses+        (perhaps with quotation markers) +        unless they do not broke the parsing of the whole trees.+    It is all your responsibility to make sure of it.+    +    This parser accepts various types of text stream,+        including 'String', 'Data.Text.Text' and 'Data.Text.Lazy.Text'.+    You might need to manually annotate the type of this parser+        to specify what type of stream you target at in the following way:+    +    > (pUnsafeDoc :: ParsecT Void Text Identity [Tree Text])++    @since 0.1.1+-}+pUnsafeDoc :: (+        Ord err,+        TPC.UnsafelyParsableAsTerm str term,+        Monad m,+        Token str ~ Char,+        Tokens str ~ str+    ) => ParsecT err str m [Tree term]+pUnsafeDoc = do+    MC.space +    doc <- many $ lexer TPC.pUnsafeTree+    eof+    return doc++type PennDocParserT str m term = ParsecT Void str m [Tree term]+type PennDocParser str term = PennDocParserT str Identity term

@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}-+{-# LANGUAGE QuasiQuotes #-} module Data.Tree.Parser.Penn.Megaparsec.CharSpec (     spec ) where@@ -15,10 +15,14 @@ import Text.Megaparsec  import Data.Tree.Parser.Penn.Megaparsec.Char as TC+import Data.Tree.Parser.Penn.Megaparsec.Char.QQ  parser :: (Monad m) => TC.PennTreeParserT Text m Text parser = TC.pTree +parserUnsafe :: (Monad m) => TC.PennTreeParserT Text m Text+parserUnsafe = TC.pUnsafeTree+ spec :: Spec spec = do     describe "pTree" $ do@@ -30,6 +34,37 @@             parseTest parser "A B V"             parseTest parser "A (B V)"             parseTest parser "(A (B V))"+            parseTest parser "( A (B V))"             parseTest parser "(A (B C (D E)))"         it "fails against broken trees" $ do             parseTest parser "(A (B C (D E)"+    describe "pTreeQQ" $ do+        it "parses" $ example $ do+            return [penn| () |]+            return [penn| ( ) |]+            return [penn| A |]+            return [penn| (A (B V)) |]+            return [penn| ( A (B V)) |]+            return [penn| (A (B C (D E))) |]+            return ()+    describe "pUnsafeTree" $ do+        it "parses" $ do +            parseTest parserUnsafe ""+            parseTest parserUnsafe "()"+            parseTest parserUnsafe "( )"+            parseTest parserUnsafe "A"+            parseTest parserUnsafe "A B V"+            parseTest parserUnsafe "A (B V)"+            parseTest parserUnsafe "(A (B V))"+            parseTest parserUnsafe "(A (B C (D E)))"+        it "fails against broken trees" $ do+            parseTest parserUnsafe "(A (B C (D E)"+    describe "pUnsafeTreeQQ" $ do+        it "parses" $ example $ do+            return [pennUnsafe| () |]+            return [pennUnsafe| ( ) |]+            return [pennUnsafe| A |]+            return [pennUnsafe| (A (B V)) |]+            return [pennUnsafe| ( A (B V)) |]+            return [pennUnsafe| (A (B C (D E))) |]+            return ()