penntreebank-megaparsec (empty) → 0.1.0

raw patch · 8 files changed

+515/−0 lines, 8 filesdep +basedep +containersdep +hspec

Dependencies added: base, containers, hspec, megaparsec, mtl, penntreebank-megaparsec, text, transformers

Files

• LICENSE +30/−0
• README.md +69/−0
• penntreebank-megaparsec.cabal +68/−0
• src/Data/Tree/Parser/Penn/Megaparsec/Char.hs +182/−0
• src/Data/Tree/Parser/Penn/Megaparsec/Internal.hs +38/−0
• src/Text/PennTreebank/Parser/Megaparsec/Char.hs +92/−0
• test/unit/Data/Tree/Parser/Penn/Megaparsec/CharSpec.hs +35/−0
• test/unit/Spec.hs +1/−0

@@ -0,0 +1,30 @@+Copyright T. N. Hayashi (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of T. N. Hayashi nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,69 @@+# penntreebank-megaparsec :: Megaparsec parsers for trees in the Penn Treebank format+![Travis CI build :: master](https://img.shields.io/travis/aslemen/penntreebank-megaparsec/master?label=Travis%20CI%20build%20%3A%3A%20master)++This Haskell package provides parsers for syntactic trees annotated +    in the Penn Treebank format, powered +    by [Megaparsec](https://hackage.haskell.org/package/megaparsec).++It supports vertical composition of custom label parsers with tree parsers,+    which means you can customize your label parsers +    and use these parsers to perform parsing of labels+    at the same time as that of trees.+For the following example of categorial grammar trees,++```+(A/B (B He)+     (B\<A/B> thinks))+```++the result of tree parsing is:++```haskell+Node "A/B" [+    Node "B" [+        Node "He" []+    ], +    Node "B\<A/B>" [+        Node "thinks" []+    ]+] +```++which you can make followed by a secondary parsing of labels (= categories):++```haskell+Node (CatRight (Atom B) (Atom A)) [+    Node (Atom B) [+        Node (Lex "He") []+    ], +    Node (CatLeft (Atom B) (CatRight (Atom B) (Atom A))) [+        Node (Lex "thinks") []+    ]+] +```++## Usage +```haskell+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE MultiParamTypeClasses #-}++import Data.Tree.Parser.Penn.Megaparsec.Char as TC+import Data.Text (Text)+import Text.Megaparsec as MegaP++-- define the node type+data PennNode = NonTerm Text | Term Text deriving (Show)++-- define the node parsers+instance {-# OVERLAPS #-} TC.ParsableAsTerm Text PennNode where+    pNonTerm = NonTerm <$> MegaP.takeRest+    pTerm = Term <$> MegaP.takeRest++-- specify and disambiguate the type of the input stream +parser :: (Monad m) => TC.PennTreeParserT Text m PennNode+parser = TC.pTree++main :: IO ()+main = MegaP.parseTest parser "(A (B C (D E)))"++```

@@ -0,0 +1,68 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 51655472fc364cb3aeec7d393dc61d5a63bc39a28b01833e78f57bec3545b7c8++name:           penntreebank-megaparsec+version:        0.1.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.+category:       Parsing, Natural Language Processing+homepage:       https://github.com/aslemen/penntreebank-megaparsec#readme+bug-reports:    https://github.com/aslemen/penntreebank-megaparsec/issues+author:         Nori Hayashi+maintainer:     Nori Hayashi <net@hayashi-lin.net>+copyright:      2020 Nori Hayashi+license:        BSD3+license-file:   LICENSE+tested-with:    GHC==8.4.4, GHC==8.6.5, GHC==8.8.1+build-type:     Simple+extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/aslemen/penntreebank-megaparsec++library+  exposed-modules:+      Data.Tree.Parser.Penn.Megaparsec.Char+      Data.Tree.Parser.Penn.Megaparsec.Internal+      Text.PennTreebank.Parser.Megaparsec.Char+  other-modules:+      Paths_penntreebank_megaparsec+  hs-source-dirs:+      src+  build-depends:+      base >=4.11 && <5+    , containers >=0.5 && <0.7+    , megaparsec >=8.0 && <9+    , mtl >=2.2.2 && <3+    , transformers >=0.4 && <0.6+  default-language: Haskell2010++test-suite unit-tests+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Data.Tree.Parser.Penn.Megaparsec.CharSpec+      Paths_penntreebank_megaparsec+  hs-source-dirs:+      test/unit+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-tool-depends:+      hspec-discover:hspec-discover+  build-depends:+      base >=4.11 && <5+    , containers >=0.5 && <0.7+    , hspec >=2.0 && <3.0+    , megaparsec >=8.0 && <9+    , mtl >=2.2.2 && <3+    , penntreebank-megaparsec+    , text >=0.2 && <1.3+    , transformers >=0.4 && <0.6+  default-language: Haskell2010

@@ -0,0 +1,182 @@+{-|+    Module          : Data.Tree.Parser.Penn.Megaparsec+    Description     : Parser combinators that parse 'Data.Text' +                        or 'String' streams to generate Penn Treebank trees.+    Copyright       : (c) 2020 Nori Hayashi+    License         : BSD3+    Maintainer      : Nori Hayashi <net@hayashi-lin.net>+    Stability       : experimental+    Portability     : portable+    Language        : Haskell2010+-}++{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Data.Tree.Parser.Penn.Megaparsec.Char (+    -- * Parsers+    pTree,+    ParsableAsTerm(..),++    -- * Parser Type Synonyms+    PennTreeParserT,+    PennTreeParser,++    -- * Parser Runners+    -- | Re-imported from "Text.Megaparsec".+    parse,+    parseMaybe,+    parseTest,+    runParser,+    runParser',+    runParserT,+    runParserT'+) where++import Data.Char as DCh+import Data.Tree+import Data.Void (Void)+import Data.Proxy (Proxy(..))++import Text.Megaparsec+import qualified Text.Megaparsec.Char as MC+import qualified Text.Megaparsec.Char.Lexer as Lex++import Control.Monad (forM_)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Identity (Identity)++import Data.Tree.Parser.Penn.Megaparsec.Internal+    +-- | A parser (monad transformer) that consumes spaces.+spaceConsumer :: (MonadParsec err str m, Token str ~ Char) => m ()+spaceConsumer+    = Lex.space+        MC.space1   -- Space+        empty       -- LineComment+        empty       -- BlockComment++-- | A parser (monad transformer) wrapper to make lexemes separated by spaces.+lexer :: (MonadParsec err str m, Token str ~ Char) +    => m term -- ^ A lexeme parser to be wrapped+    -> m term -- ^ The parser wrapped by spaces +lexer = Lex.lexeme spaceConsumer++-- | A parser (monad transformer) wrapper that parenthesize the given parser.+pParens :: (+    MonadParsec err str m, +    Token str ~ Char,+    Tokens str ~ str+    ) => m term -- ^ A parser to be wrapped+    -> m term   -- ^ The parser wrapped by parentheses+pParens = +    between+        (lexer $ single '(')+        (lexer $ single ')')++-- | A parser for raw node labels.+invokeLabelParserRaw :: (MonadParsec err str m, Token str ~ Char)  +    => m (Tokens str)+invokeLabelParserRaw +    = takeWhile1P+        (Just "Literal String")+        (\x -> x /= '(' && x /= ')' && not (DCh.isSpace x))++{-|+    A vertial parser (monad transformer) compositor that +    make raw node labels get a secondary parse+    by another parser.+-}+invokeLabelParser :: (+        Ord err,+        ParsableAsTerm str term,+        Monad m,+        Token str ~ Char,+        Tokens str ~ str+    ) => ParsecT err str m term -- ^ A secondary parser for node labels+    -> State str err            -- ^ The state given by the main parsing thread+    -> ParsecT err str m term   -- ^ The resulting parser that is going to be embedded in the main thread +invokeLabelParser labelParser substate = do+    (_, res) <- lift $ runParserT' (labelParser <* eof) substate+    case res of+        Left b@(ParseErrorBundle errors _) -> do+            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,+        @str@ is the type of the stream,+        @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+        specifying the type @term@ as an instance of '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+        to specify what type of stream you target at in the following way:+    +    > (pTree :: ParsecT Void Text Identity (Tree Text))+-}++pTree ::+    (+        Ord err,+        ParsableAsTerm str term,+        Monad m,+        Token str ~ Char,+        Tokens str ~ str+    ) => ParsecT err str m (Tree term)+pTree+    = pParens pTreeInside <|> pTerminalNode <?> "Parsed Tree"+    where +        pTreeInside :: forall str. forall err. forall m. forall term.  (+                Ord err,+                ParsableAsTerm str term,+                Monad m,+                Token str ~ Char,+                Tokens str ~ str+            ) => ParsecT err str m (Tree term)+        pTreeInside = do+            state <- getParserState+            maybeLabelRaw <- lexer $ optional invokeLabelParserRaw+            let substate = state {+                stateInput +                    = case maybeLabelRaw of +                        Just labelRaw -> labelRaw+                        Nothing -> tokensToChunk pxy []+                ,+                stateOffset = 0+            }+            labelParsed <- invokeLabelParser pNonTerm substate+            children <- many $ lexer pTree -- Recursion+            return $ Node labelParsed children+            where+                pxy :: Proxy str+                pxy = Proxy+            +        pTerminalNode :: (+                Ord err,+                ParsableAsTerm str term,+                Monad m,+                Token str ~ Char,+                Tokens str ~ str+            ) => ParsecT err str m (Tree term)+        pTerminalNode = do+            state <- getParserState+            labelRaw <- lexer $ invokeLabelParserRaw+            labelParsed <- do+                let substate = state {+                    stateInput = labelRaw,+                    stateOffset = 0+                }+                invokeLabelParser pTerm substate+            return $ Node labelParsed []++type PennTreeParserT str m term = ParsecT Void str m (Tree term)+type PennTreeParser str term = PennTreeParserT str Identity term

@@ -0,0 +1,38 @@+{-|+    Module          : Data.Tree.Parser.Penn.Megaparsec.Internal+    Description     : The internal module for tree parsers+    Copyright       : (c) 2020 Nori Hayashi+    License         : BSD3+    Maintainer      : Nori Hayashi <net@hayashi-lin.net>+    Stability       : experimental+    Portability     : portable+    Language        : Haskell2010+-}++{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeFamilies #-}++module Data.Tree.Parser.Penn.Megaparsec.Internal (+    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@.+-}+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@.+    -}+    pNonTerm :: (Ord err) => ParsecT err str m term+    pTerm :: (Ord err) => ParsecT err str m term++instance (Stream str, Tokens str ~ term) +    => ParsableAsTerm str term where+    pNonTerm = takeRest+    pTerm = takeRest

@@ -0,0 +1,92 @@+{-|+    Module          : Data.Tree.Parser.Penn.Megaparsec+    Description     : Parser combinators that parse Penn Trebank files.+    Copyright       : (c) 2020 Nori Hayashi+    License         : BSD3+    Maintainer      : Nori Hayashi <net@hayashi-lin.net>+    Stability       : experimental+    Portability     : portable+    Language        : Haskell2010+-}++{-# LANGUAGE TypeFamilies #-}++module Text.PennTreebank.Parser.Megaparsec.Char (+    -- * Parser+    pDoc,++    -- * Parser Runners+    -- | Re-imported from "Text.Megaparsec".+    parse,+    parseMaybe,+    parseTest,+    runParser,+    runParser',+    runParserT,+    runParserT'+) where++import Text.Megaparsec+import Text.Megaparsec.Char.Lexer as Lex++import Data.Maybe (fromMaybe, catMaybes)+import Data.Tree+import Data.Void (Void)+import qualified Text.Megaparsec.Char as MC+import qualified Data.Tree.Parser.Penn.Megaparsec.Char as TPC++import Control.Monad (forM_)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Identity (Identity)++data ParserOption = ParserOption {+    ignoreLabelError :: Bool +}++-- | A parser (monad transformer) that consumes spaces.+spaceConsumer :: (MonadParsec err str m, Token str ~ Char) => m ()+spaceConsumer+    = Lex.space+        MC.space1   -- Space+        empty       -- LineComment+        empty       -- BlockComment++-- | A parser (monad transformer) wrapper to make lexemes separated by spaces.+lexer :: (MonadParsec err str m, Token str ~ Char) +    => m term -- ^ A lexeme parser to be wrapped+    -> m term -- ^ The parser wrapped by spaces +lexer = Lex.lexeme spaceConsumer++{-|+    A parser (parser monad transformer) +        for treebank files 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.++    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 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:+    +    > (pDoc :: ParsecT Void Text Identity [Tree Text])+-}+pDoc :: (+        Ord err,+        TPC.ParsableAsTerm str term,+        Monad m,+        Token str ~ Char,+        Tokens str ~ str+    ) => ParsecT err str m [Tree term]+pDoc = do+    MC.space +    doc <- many $ lexer TPC.pTree+    eof+    return doc

@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Tree.Parser.Penn.Megaparsec.CharSpec (+    spec+) where++import Test.Hspec+-- import Test.QuickCheck+-- import Control.Exception (evaluate)+import Control.Monad.Identity++import Data.Void (Void)+import Data.Text (Text)+import Data.Tree +import Text.Megaparsec++import Data.Tree.Parser.Penn.Megaparsec.Char as TC++parser :: (Monad m) => TC.PennTreeParserT Text m Text+parser = TC.pTree++spec :: Spec+spec = do+    describe "pTree" $ do+        it "parses" $ do +            parseTest parser ""+            parseTest parser "()"+            parseTest parser "( )"+            parseTest parser "A"+            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)"

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}