diff --git a/README b/README --- a/README +++ b/README @@ -2,6 +2,7 @@ #+TITLE: hs-conllu [[https://travis-ci.org/odanoburu/hs-conllu][file:https://travis-ci.org/odanoburu/hs-conllu.svg?branch=master]] +[[http://hackage.haskell.org/package/hs-conllu][file:https://img.shields.io/hackage/v/hs-conllu.svg?style=flt]] this package provides a validating[fn:1] parser of the [[http://universaldependencies.org/format.html][CoNLL-U format]], along with a data model for its constituents. reading, pretty-printing, and @@ -11,6 +12,8 @@ a separate package. * installation +=hs-conllu= is available on [[http://hackage.haskell.org/package/hs-conllu][Hackage]], but if you prefer to install from +source: #+BEGIN_SRC sh cd /path/of/choice/ git clone $REPO_URL @@ -26,8 +29,8 @@ stack install --system-ghc #+END_SRC - the library is tested with GHC versions 8.0.2, 8.2.2, and 8.4.1 on - Linux and on OSX (thanks Travis!). + the library is tested with multiple GHC versions, on Linux and on + OSX (thanks Travis!). if you have problems with the dependency versions, you may try to alter them in the cabal file for the version you have. the version @@ -80,7 +83,7 @@ ** Diffing see the =Diff= module Haddock documentation. - + * contributing I'm a new haskeller, so any help will probably be useful -- even if its just a few pointers and comments on how I can improve the diff --git a/TODO b/TODO deleted file mode 100644 --- a/TODO +++ /dev/null @@ -1,17 +0,0 @@ -# -*- mode: org -*- -#+TITLE: hs-conllu TODO -* Library: -- Convert String -> Text -- use quickcheck for property testing - (https://begriffs.com/posts/2017-01-14-design-use-quickcheck.html) - -** Type - - should I remove Maybe's where I can ([] as Nothing)? - -** Parse -- warn of spaces in fields where they are not allowed (FORM and - LEMMA). do this in symbol function. -- check what's the purpose of the =_= in this MISC field: - =_|SpaceAfter=Yes=. should it be allowed? -- create non validating parser - : count 10 (stringNot "\t\n" <* tab) diff --git a/hs-conllu.cabal b/hs-conllu.cabal --- a/hs-conllu.cabal +++ b/hs-conllu.cabal @@ -1,26 +1,56 @@ +cabal-version: 2.4 name: hs-conllu -version: 0.1.2 +version: 0.1.5 synopsis: Conllu validating parser and utils. description: utilities to parse, print, diff, and analyse data in CoNLL-U format. -extra-doc-files: README - , CHANGELOG - , TODO homepage: https://github.com/odanoburu/hs-conllu bug-reports: https://github.com/odanoburu/hs-conllu/issues -license: LGPL-3 +license: LGPL-3.0-only license-file: LICENSE author: bruno cuconato maintainer: bruno cuconato -category: Language +copyright: 2021 bruno cuconato build-type: Simple -cabal-version: >=1.18 -tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.1 +extra-doc-files: README + CHANGELOG +tested-with: GHC == 8.8.3 source-repository head - type: git - location: https://github.com/odanoburu/hs-conllu.git + type: git + location: https://github.com/odanoburu/hs-conllu.git +common common-options + build-depends: base >=4.9 && <5, + containers == 0.6.*, + directory ==1.3.*, + filepath ==1.4.*, + megaparsec ==9.*, + void <1 + + ghc-options: -Wall + -Wcompat + -Widentities + -Wincomplete-uni-patterns + -Wincomplete-record-updates + if impl(ghc >= 8.0) + ghc-options: -Wredundant-constraints + if impl(ghc >= 8.2) + ghc-options: -fhide-source-paths + if impl(ghc >= 8.4) + ghc-options: -Wmissing-export-lists + -Wpartial-fields + if impl(ghc >= 8.8) + ghc-options: -Wmissing-deriving-strategies + + default-language: Haskell2010 + default-extensions: DisambiguateRecordFields, DerivingStrategies, + DuplicateRecordFields, + NamedFieldPuns, OverloadedStrings, RecordWildCards, + TupleSections, ScopedTypeVariables + library + import: common-options + hs-source-dirs: src exposed-modules: Conllu.Type, Conllu.UposTagset, Conllu.DeprelTagset, @@ -29,31 +59,20 @@ Conllu.Diff, Conllu.Utils, Conllu.Print --- other-modules: Conllu.Utils - -- other-extensions: - build-depends: base >=4.9 && <5, - containers >0.5.8 && <0.6, - directory >=1.3 && <1.4, - filepath >=1.4 && <1.5, - megaparsec >=6 && <7, - void <1 - hs-source-dirs: src - default-language: Haskell2010 executable hs-conllu - hs-source-dirs: src - main-is: Main.hs - default-language: Haskell2010 - build-depends: base >= 4.9 && <5, - containers >0.5.8 && <0.6, - directory >=1.3 && <1.4, - filepath >=1.4 && <1.5, - megaparsec >=6 && <7 - other-modules: Conllu.Type, - Conllu.UposTagset, - Conllu.DeprelTagset, - Conllu.Diff, - Conllu.IO, - Conllu.Parse, - Conllu.Utils, - Conllu.Print + import: common-options + hs-source-dirs: src + main-is: Main.hs + build-depends: hs-conllu + ghc-options: -threaded + -rtsopts + -with-rtsopts=-N + other-modules: Conllu.DeprelTagset, + Conllu.Diff, + Conllu.IO, + Conllu.Parse, + Conllu.Print, + Conllu.Type, + Conllu.UposTagset, + Conllu.Utils diff --git a/src/Conllu/DeprelTagset.hs b/src/Conllu/DeprelTagset.hs --- a/src/Conllu/DeprelTagset.hs +++ b/src/Conllu/DeprelTagset.hs @@ -16,15 +16,16 @@ module Conllu.DeprelTagset where data EP - = ACL + = REF -- ^ only allowed in DEPS + | ACL | ADVCL | ADVMOD | AMOD | APPOS | AUX | CASE - | CC | CCOMP + | CC | CLF | COMPOUND | CONJ @@ -49,7 +50,6 @@ | ORPHAN | PARATAXIS | PUNCT - | REF -- ^ only allowed in DEPS | REPARANDUM | ROOT | VOCATIVE diff --git a/src/Conllu/Parse.hs b/src/Conllu/Parse.hs --- a/src/Conllu/Parse.hs +++ b/src/Conllu/Parse.hs @@ -60,18 +60,15 @@ import Data.Maybe import Data.Void (Void) -import Text.Megaparsec - (ParseError, Parsec, (), (<|>), between, eitherP, endBy1, eof, - lookAhead, many, option, optional, parse, parseErrorPretty, sepBy, - sepBy1, skipManyTill, some, takeWhileP, try, withRecovery) +import qualified Text.Megaparsec as TM import Text.Megaparsec.Char import qualified Text.Megaparsec.Char.Lexer as L -- | Parser type synonym -type Parser = Parsec Void String +type Parser = TM.Parsec Void String -- | Parser raw output -type RawData t e = [Either (ParseError t e) Sent] +type RawData t e = [Either (TM.ParseError t e) Sent] -- | DEPREL field type synonym type DEPREL = Maybe (D.EP, Maybe String) @@ -79,42 +76,40 @@ --- -- conllu parsers -rawSents :: Parser (RawData Char Void) +rawSents :: Parser (RawData String Void) -- | parse CoNLL-U sentences with recovery. rawSents = rawSentsC sentence -rawSentsC :: Parser Sent -> Parser (RawData Char Void) +rawSentsC :: Parser Sent -> Parser (RawData String Void) -- | parse CoNLL-U sentences with recovery, using a custom parser. -rawSentsC sent = between ws eof (e `endBy1` lineFeed) +rawSentsC sent = TM.between ws TM.eof (TM.endBy1 e lineFeed) where - e = withRecovery recover (Right <$> sent) + e = TM.withRecovery recover (Right <$> sent) recover err = Left err <$ - skipManyTill anyChar + TM.skipManyTill TM.anySingle -- if parser consumes the first newline but can't parse the -- second, it breaks; it can't consume the second one, because -- that one has to be consumed by the endBy1 - (try $ lineFeed *> lookAhead lineFeed) + (TM.try $ lineFeed *> TM.lookAhead lineFeed) lineFeed :: Parser () -- | parse a blank line. -lineFeed = lexeme . void $ newline -- spaces shouldn't exist, but no - -- problem being lax here +lineFeed = lexeme . void $ newline -- Spaces shouldn't exist, but no problem being lax here sentence :: Parser Sent -- | the default sentence parser. sentence = sentenceC comment word -sentenceC :: Parser Comment -> Parser (CW AW) - -> Parser Sent +sentenceC :: Parser Comment -> Parser (CW AW) -> Parser Sent -- | the customizable sentence parser. -sentenceC c t = liftM2 Sent (many c) (some t) +sentenceC c t = liftM2 Sent (TM.many c) (TM.some t) comment :: Parser Comment -- | parse a comment. comment = - (symbol "#" "comment starter") *> commentPair <* - lineFeed "comment content" + (symbol "#" TM. "comment starter") *> commentPair <* + lineFeed TM. "comment content" word :: Parser (CW AW) -- | the default word parser. @@ -134,19 +129,19 @@ -> Parser (CW AW) -- | the customizable token parser. wordC ixp fop lp upp xpp fsp drp dsp mp = do - i <- ixp <* tab - mf <- fop <* tab - ml <- lp <* tab + i <- ixp <* tab + mf <- fop <* tab + ml <- lp <* tab mup <- upp <* tab mxp <- xpp <* tab mfs <- fsp <* tab mdh <- dhp <* tab mdr <- drp <* tab - ds <- dsp <* tab - mm <- mp <* lineFeed + ds <- dsp <* tab + mm <- mp <* lineFeed return $ mkAW i mf ml mup mxp mfs (rel mdh mdr) ds mm where - dhp = maybeEmpty ixp "HEAD" + dhp = maybeEmpty ixp TM. "HEAD" rel :: Maybe ID -> DEPREL -> Maybe Rel rel mdh mdr = do dh <- mdh @@ -155,14 +150,14 @@ emptyField :: Parser (Maybe a) -- | parse an empty field. -emptyField = symbol "_" *> return Nothing "empty field" +emptyField = symbol "_" *> return Nothing TM. "empty field (_)" idW :: Parser ID -- | parse the ID field, which might be an integer, a range, or a -- decimal. idW = do ix <- index - mix <- optional metaIndex "meta token ID" + mix <- TM.optional metaIndex TM. "meta token ID" return $ case mix of Nothing -> SID ix @@ -171,10 +166,10 @@ where index :: Parser Index index = do - ix <- some digitChar "ID" + ix <- TM.some digitChar TM. "ID" return (read ix :: Int) indexSep :: Parser (Either IxSep IxSep) - indexSep = eitherP (char '-') (char '.') "meta separator" + indexSep = TM.eitherP (char '-') (char '.') TM. "meta separator" metaIndex :: Parser (Either IxSep IxSep, Index) metaIndex = do sep <- indexSep @@ -183,85 +178,85 @@ form :: Parser FORM -- | parse the FORM field. -form = orEmpty stringWSpaces "FORM" +form = orEmpty stringWSpaces TM. "FORM" lemma :: Parser LEMMA -- | parse the LEMMA field. -lemma = orEmpty stringWSpaces "LEMMA" +lemma = orEmpty stringWSpaces TM. "LEMMA" upos :: Parser UPOS -- | parse the UPOS field. -upos = maybeEmpty upos' "UPOS" +upos = maybeEmpty upos' where upos' :: Parser U.POS - upos' = fmap mkUPOS stringWOSpaces + upos' = fmap mkUPOS $ TM.choice $ fmap (string' . show) [U.ADJ .. U.X] xpos :: Parser XPOS -- | parse the XPOS field. -xpos = maybeEmpty stringWOSpaces "XPOS" +xpos = maybeEmpty stringWOSpaces TM. "XPOS" feats :: Parser FEATS -- | parse the FEATS field. -feats = listP (feat `sepBy` symbol "|" "FEATS") +feats = listP (feat `TM.sepBy` symbol "|" TM. "FEATS") where feat = do - k <- lexeme (some alphaNumChar "feature key") + k <- lexeme (TM.some alphaNumChar TM. "feature key") ft <- - optional $ - between (symbol "[") (symbol "]") (some alphaNumChar) + TM.optional $ + TM.between (symbol "[") (symbol "]") (TM.some alphaNumChar) _ <- symbol "=" - vs <- fvalue `sepBy1` symbol "," + vs <- fvalue `TM.sepBy1` symbol "," return $ Feat k vs ft - fvalue = lexeme (some alphaNumChar "feature value") + fvalue = lexeme (TM.some alphaNumChar TM. "feature value") deprel :: Parser DEPREL -- | parse the DEPREL field. deprel = maybeEmpty deprel' dep :: Parser D.EP -dep = fmap mkDEP (letters "DEPREL") +dep = fmap mkDEP $ TM.choice $ fmap (string' . show) [D.ACL .. D.XCOMP] deprel' :: Parser (D.EP, Maybe String) -- | parse a non-empty DEPREL field. deprel' = liftM2 (,) dep subdeprel where subdeprel :: Parser (Maybe String) - subdeprel = optional (symbol ":" *> letters "DEPREL subtype") + subdeprel = TM.optional (symbol ":" *> letters TM. "DEPREL subtype") deps :: Parser DEPS -- | parse the DEPS field. -deps = listP (eDep `sepBy` symbol "|" "DEPS") +deps = listP (eDep `TM.sepBy` symbol "|" TM. "DEPS") where eDep = do - h <- idW "enhanced dependency HEAD" + h <- idW TM. "enhanced dependency HEAD" _ <- sep - d <- dep "enhanced dependency DEPREL" + d <- dep TM. "enhanced dependency DEPREL" restI <- - optional + TM.optional (sep *> - stringNot "\t| :" `sepBy` sep + stringNot "\t| :" `TM.sepBy` sep TM. "enhanced dependency information") return $ Rel h d Nothing restI sep = symbol ":" misc :: Parser MISC -- | parse the MISC field. -misc = orEmpty stringWSpaces "MISC" +misc = orEmpty stringWSpaces TM. "MISC" --- -- utility parsers commentPair :: Parser Comment -- | parse a comment pair. commentPair = - keyValue "=" (stringNot "=\n\t") (option "" stringWSpaces) + keyValue "=" (stringNot "=\n\t") (TM.option "" stringWSpaces) listPair :: String -> Parser a -> Parser b -> Parser [(a, b)] -- | parse a list of pairs. -listPair sep p q = keyValue sep p q `sepBy1` symbol "|" +listPair sep p q = keyValue sep p q `TM.sepBy1` symbol "|" stringNot :: String -> Parser String -- | parse any chars except the ones provided. -stringNot s = lexeme . some $ satisfy (`notElem` s) +stringNot s = lexeme $ TM.takeWhile1P Nothing (`notElem` s) stringWOSpaces :: Parser String -- | parse a string until a space, a tab, or a newline. @@ -273,7 +268,7 @@ letters :: Parser String -- | parse a string of letters. -letters = lexeme $ some letterChar +letters = lexeme $ TM.some letterChar --- -- parser combinators @@ -281,7 +276,7 @@ -- | parse a (key, value) pair. keyValue sep p q = do key <- p - _ <- optional $ symbol sep + _ <- TM.optional $ symbol sep value <- q return (key, value) @@ -301,7 +296,7 @@ maybeEmpty :: Parser a -> Parser (Maybe a) -- | a parser combinator for parsers that won't parse "_" (e.g., as -- 'lemma' would). -maybeEmpty p = emptyField <|> fmap Just p +maybeEmpty p = emptyField TM.<|> fmap Just p orEmpty :: Parser String -> Parser (Maybe String) -- | a parser combinator for parsers that may parse "_". @@ -327,7 +322,7 @@ lexeme = L.lexeme ws ws :: Parser () -ws = void $ takeWhileP (Just "space") (== ' ') +ws = void $ TM.takeWhileP (Just "space") (== ' ') --- -- customizable parser @@ -368,7 +363,7 @@ -- @ parserC p = let i = _idP p - f = _formP p + f = _formP p l = _lemmaP p up = _upostagP p xp = _xpostagP p @@ -391,15 +386,16 @@ -> Either String Doc -- | parse a CoNLL-U document using a customized parser. parseConlluWith p fp s = - case parse doc fp s of - Left err -> Left $ parseErrorPretty err - Right d -> + case TM.parse doc fp s of + Left err -> Left $ TM.errorBundlePretty err + Right d -> let (ls, rs) = partitionEithers d in if null ls then Right rs - else Left $ concatMap parseErrorPretty ls + else Left $ concatMap TM.parseErrorPretty ls where doc = rawSentsC p + parseConllu :: FilePath -> String -> Either String Doc -- | parse a CoNLL-U document using the default parser. diff --git a/src/Conllu/Type.hs b/src/Conllu/Type.hs --- a/src/Conllu/Type.hs +++ b/src/Conllu/Type.hs @@ -87,6 +87,7 @@ compare = idOrd where idOrd :: ID -> ID -> Ordering + idOrd (SID x) (SID y) = compare x y idOrd id1 id2 = let c = comparing fstIx id1 id2 in case c of @@ -142,7 +143,7 @@ depIs :: D.EP -> CW SW -> Bool -- | check if DEP is the one provided. -depIs d = maybe False (\d' -> d == d') . _dep +depIs d = maybe False (d ==) . _dep --- -- ** constructor functions