diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Sergey Bushnyak (c) 2017 + +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 Sergey Bushnyak 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,31 @@ +# haskell-conll + +[![Build Status](https://travis-ci.com/mgajda/haskell-conll.svg?token=DtSUtnf37TUDy1p4x6fT&branch=master)](https://travis-ci.com/mgajda/haskell-conll) + +Set of Basic Types and Primitives that are used for NLP software such as +- CoreNLP +- SyntaxNet + +and can be extended for usage with other software. + +If you're working on custom solutions you can use it also. + +# TreeBanks + +Library supports + +- [Penn Treebank Tag-set](http://www.comp.leeds.ac.uk/amalgam/tagsets/upenn.html) +- [Universal Dependencies](http://universaldependencies.org/en/dep/) + +# Used + +This library is used in + +- [SyntaxNet Haskell bindings](https://github.com/mgajda/syntaxnet-haskell/) +- [CoreNLP Haskell bindings](https://github.com/mgajda/corenlp-haskell/) + +# Acknowledgements + +- [Michał J. Gajda](https://github.com/mgajda) +- [Alejandro Duran Pallares](https://github.com/vwwv) +- [Sergey Bushnyak](https://github.com/sigrlami) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/haskell-conll.cabal b/haskell-conll.cabal new file mode 100644 --- /dev/null +++ b/haskell-conll.cabal @@ -0,0 +1,74 @@ +name: haskell-conll +version: 0.1.0.0 +synopsis: Core Types for NLP +description: Provides core types to work with CoreNLP, SyntaxNet. Handling CoNLL format and Syntax Trees. +homepage: https://github.com/sigrlami/haskell-conll#readme +license: BSD3 +license-file: LICENSE +author: Sergey Bushnyak, Alejandro Duran-Pallares, Michal Gajda +maintainer: sergey.bushnyak@sigrlami.eu +copyright: Copyright: (c) 2017 Sergey Bushnyak, Michal Gajda, Alejandro Duran-Pallares +category: Text +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Data.ConllToken + , Data.ParsedSentence + , Data.SyntaxTree + , Data.TagLabel + , Model.NerCoreNlp + , Model.PennTreebank + , Model.UniversalTreebank + + build-depends: base >= 4.7 && < 5 + , containers + , lens + , pretty-show + , protolude + , split + , text + + default-language: Haskell2010 + + default-extensions: NoImplicitPrelude + , BangPatterns + , BinaryLiterals + , ConstraintKinds + , DataKinds + , DefaultSignatures + , DeriveFunctor + , DeriveGeneric + , DisambiguateRecordFields + , DuplicateRecordFields + , EmptyDataDecls + , FlexibleContexts + , FlexibleInstances + , FunctionalDependencies + , GADTs + , GeneralizedNewtypeDeriving + , LambdaCase + , MonadComprehensions + , MultiParamTypeClasses + , MultiWayIf + , OverloadedStrings + , PartialTypeSignatures + , PatternSynonyms + , RankNTypes + , RecordWildCards + , RecursiveDo + , ScopedTypeVariables + , StandaloneDeriving + , TemplateHaskell + , TupleSections + , TypeFamilies + , TypeInType + , TypeOperators + , TypeSynonymInstances + + +source-repository head + type: git + location: https://github.com/sigrlami/haskell-conll diff --git a/src/Data/ConllToken.hs b/src/Data/ConllToken.hs new file mode 100644 --- /dev/null +++ b/src/Data/ConllToken.hs @@ -0,0 +1,36 @@ +module Data.ConllToken where + +import Protolude +import Control.Lens + +-------------------------------------------------------------------------------- + +-- | Basic data type to work witn CoNLL data format +-- +data ConllToken cpos fpos ger feats lemma = + ConllToken + { _tnId :: Int -- ^ Index number + , _tnWord :: Text -- ^ Parsed word or punctuation symbol + , _tnLemma :: lemma -- ^ Lemma or stem + , _tnPosCG :: cpos -- ^ Part-of-Speech (POS) coarse-grained (PRON, VERB, DET, NOUN, etc) + , _tnPosFG :: fpos -- ^ Part-of-Speech (POS) fine-grained (PRP, VBD, DT, NN etc.) + , _tnFeats :: feats -- ^ Unordered set of syntactic and/or morphological features. + , _tnHead :: Int -- ^ Head of the current token, which is either a value of ID or '0'. + , _tnRel :: ger -- ^ grammatical relationships between different words in the sentence, alined with Head + , _tnHeadProj :: Text -- ^ Projective head of current token. + , _tnRelProj :: Text -- ^ Dependency relation to the PHEAD. + } deriving (Show, Read, Eq, Ord, Generic, Functor) + +-- | Describes typical errors when parsing CoNLL from text data +-- Contains next filelds: Reason, LineNumber, Culprit +data SyntaxErrorCoNLL = UnkonwnPosTag Int Text + | UnkwownRelTag Int Text + | CoulNotParseInteger Int Text + | InvalidNumberOfElementsOnLine Int Text + | TheresNoRoot + deriving(Show,Read,Eq,Ord) + +$(makeLenses ''ConllToken ) +$(makePrisms ''SyntaxErrorCoNLL) + + diff --git a/src/Data/ParsedSentence.hs b/src/Data/ParsedSentence.hs new file mode 100644 --- /dev/null +++ b/src/Data/ParsedSentence.hs @@ -0,0 +1,30 @@ +module Data.ParsedSentence + ( module Data.ParsedSentence + , module Data.SyntaxTree + ) where + +import Protolude +import Data.SyntaxTree +import Data.Map + +-------------------------------------------------------------------------------- + +-- | +data ParsedSentence cpos fpos ger feats lemma = + ParsedSentence + { _rootNode :: SyntaxtTree cpos fpos ger feats lemma + , _indexToNode :: Map Int (SyntaxtTree cpos fpos ger feats lemma) + , _headToNode :: Map Int [SyntaxtTree cpos fpos ger feats lemma] + -- ^ All relations having as "head" the given index + } deriving(Show,Read,Eq,Generic) + +-- | +sentenceFromRootNode :: SyntaxtTree cpos fpos ger feats lemma + -> ParsedSentence cpos fpos ger feats lemma +sentenceFromRootNode _rootNode = + ParsedSentence{..} + where + _indexToNode = fromList [ (_tnId $ rootLabel node, node ) | node <- everyNode] + _headToNode = fromListWith (++) [ (_tnHead $ rootLabel node,[node]) | node <- everyNode] + everyNode = everyNodeFrom _rootNode + everyNodeFrom node@(Node _ children) = node:( everyNodeFrom =<< children) diff --git a/src/Data/SyntaxTree.hs b/src/Data/SyntaxTree.hs new file mode 100644 --- /dev/null +++ b/src/Data/SyntaxTree.hs @@ -0,0 +1,37 @@ +module Data.SyntaxTree + ( module Data.SyntaxTree + , module Data.Tree + , module Data.ConllToken + ) where + +import Data.ConllToken +import Data.Map +import Data.Tree +import Protolude + +-------------------------------------------------------------------------------- + +-- | +type SyntaxtTree cpos fpos ger feats lemma = + Tree (ConllToken cpos fpos ger feats lemma) + +-- | +createSyntaxTree :: [ConllToken cpos fpos ger feats lemma] + -> Either SyntaxErrorCoNLL (SyntaxtTree cpos fpos ger feats lemma) +createSyntaxTree conllLines = + note TheresNoRoot $ listToMaybe (treeFrom 0) + where + + indexToNode = fromList [ (_tnId l,l) | l <- conllLines] + + headToNode = fromListWith (++) [ (_tnHead node,[node]) + | node <- conllLines + ] + + treeFrom n = let relations = fromMaybe [] $ lookup n headToNode + in [ Node{ rootLabel = node + , subForest = treeFrom (_tnId node) + } + | node <- relations + ] + diff --git a/src/Data/TagLabel.hs b/src/Data/TagLabel.hs new file mode 100644 --- /dev/null +++ b/src/Data/TagLabel.hs @@ -0,0 +1,76 @@ +module Data.TagLabel ( module GHC.Generics + , TagLabel(..) + , SpelledAs(..) + , fromLabelText + , toLabelText + ) where + +import Data.Char +import Data.Map +import GHC.Generics (Generic,Rep(..),(:+:)(..)) +import GHC.TypeLits +import Protolude hiding(fromLabel) +import qualified Data.Text as T +import qualified GHC.Generics as G + +-------------------------------------------------------------------------------- + +-- | +class (Ord label) => TagLabel label where + labelMap :: Map Text label + + default labelMap :: (Generic label, GLabel (Rep label) ) => Map Text label + labelMap = fmap G.to . fromList $ gLabelMap (Proxy :: Proxy (Rep label)) + + reverseLabelMap :: Map label Text + reverseLabelMap = fromList [ (b,a) | (a,b) <- assocs labelMap] + +-- | +fromLabelText :: (TagLabel label) => Text -> Maybe label +fromLabelText t = lookup t labelMap + +-- | +toLabelText :: (TagLabel label) => label -> Text +toLabelText l = + fromMaybe (error "imposible branch on Data.Label") + $ lookup l reverseLabelMap + +-------------------------------------------------------------------------------- +-- Machinery + +class GLabel f where + gLabelMap :: Proxy f -> [(Text, f a)] + +-- | Definitions: `D1` (instance base on to type definition metadata...we can ignore it and focus on `f`) +instance (GLabel f) => GLabel (D1 meta f) where + gLabelMap _ = second M1 <$> gLabelMap (Proxy :: Proxy f) + + +-- | The labels of sum types are the labels of its parts +instance (GLabel f, GLabel g) => GLabel ( f :+: g) where + gLabelMap _ = ( second L1 <$> gLabelMap (Proxy :: Proxy f)) + ++ ( second R1 <$> gLabelMap (Proxy :: Proxy g)) + +-- | The label of a constructor without arguments is the constructor's name itself +instance (KnownSymbol constructor) => GLabel (C1 ('MetaCons constructor a b) U1) where + gLabelMap _ = [( convert . toSL $ symbolVal (Proxy :: Proxy constructor) , M1 U1)] + where + convert s = if T.any isLower s then T.toLower s + else s +-- | The labels with a constructor with a single argument, are the labels of its argument +instance (TagLabel labelType) => GLabel (C1 meta1 (S1 meta2 (K1 meta3 labelType))) where + gLabelMap _ = assocs $ (M1 . M1 . K1) <$> labelMap + +--------------------------------------------------------------------------------------- +-- Standard labels + +-- | The labels of a sum type, is the cartesian sum of its labels +instance (TagLabel l1, TagLabel l2) => TagLabel (Either l1 l2) + +-- | The label of a `SpelledAs x` is x, where x is a type level literal string (a "Symbol"). +instance (KnownSymbol symbol) => TagLabel (SpelledAs symbol) where + labelMap = fromList [(toSL $ symbolVal (Proxy :: Proxy symbol), SymbolProxy)] + +data SpelledAs (s :: Symbol) = SymbolProxy deriving(Show,Read,Eq,Ord,Generic) + + diff --git a/src/Model/NerCoreNlp.hs b/src/Model/NerCoreNlp.hs new file mode 100644 --- /dev/null +++ b/src/Model/NerCoreNlp.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE DeriveAnyClass #-} + +module Model.NerCoreNlp where + +import Protolude +import Data.TagLabel + + +{- | Named Entity Recognition (NER) tag set used by `CoreNLP`. + + TODO: find documentation where this list is elicited. +-} + + +-- | CoreNLP's NER tag set: + +data NER = O + | CARDINAL + | DATE + | DURATION + | FACILITY + | GPE + | LOCATION + | MEASURE + | MISC + | MONEY + | NUMBER + | ORDINAL + | ORGANIZATION + | PERCENT + | PERSON + | SET + | TIME + deriving(Show,Eq,Read,Ord,Generic,TagLabel) + + + diff --git a/src/Model/PennTreebank.hs b/src/Model/PennTreebank.hs new file mode 100644 --- /dev/null +++ b/src/Model/PennTreebank.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE DeriveAnyClass #-} + +module Model.PennTreebank where + +import Protolude +import Data.TagLabel + +-------------------------------------------------------------------------------- + +-- | (Penn) Treebank Tag-set +-- For documentation see http://www.comp.leeds.ac.uk/amalgam/tagsets/upenn.html +data POS = CC + | CD + | ClosePar (SpelledAs ")" ) + | Colon (SpelledAs ":" ) + | Coma (SpelledAs ",") + | Dash (SpelledAs "--" ) + | Dollar (SpelledAs "$" ) + | DT + | EX + | FW + | IN + | JJ + | JJR + | JJS + | LRB_ (SpelledAs "-LRB-") + | LS + | MD + | NN + | NNP + | NNPS + | NNS + | OpenPar (SpelledAs "(" ) + | PDT + | POS + | PRP + | PRP_Dollar (SpelledAs "PRP$") + | Quotes (SpelledAs "''") + | Quotes2 (SpelledAs "``") + | RB + | RBR + | RBS + | RP + | RRB_ (SpelledAs "-RRB-") + | SYM + | Terminator (SpelledAs "." ) + | TO + | UH + | VB + | VBD + | VBG + | VBN + | VBP + | VBZ + | WDT + | WP + | WP_Dollar (SpelledAs "WP$") + | WRB + | UNKNOWN -- when some unknown string used + deriving(Show,Read,Eq,Ord,Generic,TagLabel) + + + + + diff --git a/src/Model/UniversalTreebank.hs b/src/Model/UniversalTreebank.hs new file mode 100644 --- /dev/null +++ b/src/Model/UniversalTreebank.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE DeriveAnyClass #-} + +module Model.UniversalTreebank where + +import Protolude +import Data.TagLabel + +-------------------------------------------------------------------------------- + +-- | Tags from Universal Dependencies project +-- see `http://universaldependencies.org/en/dep/` +data REL = Acl -- ^ clausal modifier of noun + | Acl_Relcl (SpelledAs "acl:relcl" ) -- ^ relative clause modifier + | Advcl -- ^ adverbial clause modifier + | Advmod -- ^ adverbial modifier + | Amod -- ^ adjectival modifier + | Appos -- ^ appositional modifier + | Aux -- ^ auxiliary + | Auxpass -- ^ passive auxiliary + | Case -- ^ case marking + | Cc -- ^ coordination + | Cc_Preconj (SpelledAs "cc:preconj" ) -- ^ preconjunct + | Ccomp -- ^ clausal complement + | Compound -- ^ compound + | Compound_Pr(SpelledAs "compound:prt") -- ^ phrasal verb particle + | Conj -- ^ conjunct + | Cop -- ^ copula + | Csubj -- ^ clausal subject + | Csubjpass -- ^ clausal passive subject + | Dep -- ^ dependent + | Det -- ^ determiner + | Det_Predet (SpelledAs "det:predet" ) -- ^ predeterminer + | Discourse -- ^ discourse element + | Dislocated -- ^ dislocated elements + | Dobj -- ^ direct object + | Expl -- ^ expletive + | Fixed (SpelledAs "mwe") -- ^ multi-word expression + | Flat -- ^ name + | Foreign -- ^ foreign words + | Goeswith -- ^ goes with + | Iobj -- ^ indirect object + | List -- ^ list + | Mark -- ^ marker + | Neg -- ^ negation modifier + | Nmod -- ^ nominal modifier + | Nmod_npmod (SpelledAs "nmod:npmod" ) -- ^ noun phrase as adverbial modifier + | Nmod_poss (SpelledAs "nmod:poss" ) -- ^ possessive nominal modifier + | Nmod_tmod (SpelledAs "nmod:tmod" ) -- ^ temporal modifier + | Nsubj -- ^ nominal subject + | Nsubjpass -- ^ passive nominal subject + | Nummod -- ^ numeric modifier + | Orphan -- ^ remnant in ellipsis + | Parataxis -- ^ parataxis + | Punct -- ^ punctuation + | Reparandum -- ^ overridden disfluency + | ROOT -- ^ root + | Root -- ^ root (not main) + | Vocative -- ^ vocative + | Xcomp -- ^ open clausal complement + | Unknown -- ^ unknown + deriving(Show,Read,Eq,Ord,Generic,TagLabel) +