hs-conllu (empty) → 0.1.2
raw patch · 15 files changed
+1509/−0 lines, 15 filesdep +basedep +containersdep +directorysetup-changed
Dependencies added: base, containers, directory, filepath, megaparsec, void
Files
- CHANGELOG +18/−0
- LICENSE +165/−0
- README +97/−0
- Setup.hs +2/−0
- TODO +17/−0
- hs-conllu.cabal +59/−0
- src/Conllu/DeprelTagset.hs +57/−0
- src/Conllu/Diff.hs +123/−0
- src/Conllu/IO.hs +92/−0
- src/Conllu/Parse.hs +406/−0
- src/Conllu/Print.hs +159/−0
- src/Conllu/Type.hs +192/−0
- src/Conllu/UposTagset.hs +36/−0
- src/Conllu/Utils.hs +57/−0
- src/Main.hs +29/−0
+ CHANGELOG view
@@ -0,0 +1,18 @@+# -*- mode: org -*-+#+TITLE: Revision history for hs-conllu++* 0.0.1 -- 2018-01-12++- First version. Released on an unsuspecting world.+* 0.1.0 -- 2018-04-03+- change Type module a lot -- basically breaks all existing code+- remove Data.* modules, they should be in a separate package (and+ will have to be rewritten) +- new type for words allows us to type-check simple words, multi-word+ tokens, and empty nodes+- remove Data.* modules, they should be in a separate package (and+ will have to be rewritten) (closes #6 )+- add tagsets to separate modules, to be imported qualified (closes+ #7)+- add requested parsing and printing functions (closes #9)+- add recovery function to parser (closes #18)
+ LICENSE view
@@ -0,0 +1,165 @@+ GNU LESSER GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.+++ This version of the GNU Lesser General Public License incorporates+the terms and conditions of version 3 of the GNU General Public+License, supplemented by the additional permissions listed below.++ 0. Additional Definitions.++ As used herein, "this License" refers to version 3 of the GNU Lesser+General Public License, and the "GNU GPL" refers to version 3 of the GNU+General Public License.++ "The Library" refers to a covered work governed by this License,+other than an Application or a Combined Work as defined below.++ An "Application" is any work that makes use of an interface provided+by the Library, but which is not otherwise based on the Library.+Defining a subclass of a class defined by the Library is deemed a mode+of using an interface provided by the Library.++ A "Combined Work" is a work produced by combining or linking an+Application with the Library. The particular version of the Library+with which the Combined Work was made is also called the "Linked+Version".++ The "Minimal Corresponding Source" for a Combined Work means the+Corresponding Source for the Combined Work, excluding any source code+for portions of the Combined Work that, considered in isolation, are+based on the Application, and not on the Linked Version.++ The "Corresponding Application Code" for a Combined Work means the+object code and/or source code for the Application, including any data+and utility programs needed for reproducing the Combined Work from the+Application, but excluding the System Libraries of the Combined Work.++ 1. Exception to Section 3 of the GNU GPL.++ You may convey a covered work under sections 3 and 4 of this License+without being bound by section 3 of the GNU GPL.++ 2. Conveying Modified Versions.++ If you modify a copy of the Library, and, in your modifications, a+facility refers to a function or data to be supplied by an Application+that uses the facility (other than as an argument passed when the+facility is invoked), then you may convey a copy of the modified+version:++ a) under this License, provided that you make a good faith effort to+ ensure that, in the event an Application does not supply the+ function or data, the facility still operates, and performs+ whatever part of its purpose remains meaningful, or++ b) under the GNU GPL, with none of the additional permissions of+ this License applicable to that copy.++ 3. Object Code Incorporating Material from Library Header Files.++ The object code form of an Application may incorporate material from+a header file that is part of the Library. You may convey such object+code under terms of your choice, provided that, if the incorporated+material is not limited to numerical parameters, data structure+layouts and accessors, or small macros, inline functions and templates+(ten or fewer lines in length), you do both of the following:++ a) Give prominent notice with each copy of the object code that the+ Library is used in it and that the Library and its use are+ covered by this License.++ b) Accompany the object code with a copy of the GNU GPL and this license+ document.++ 4. Combined Works.++ You may convey a Combined Work under terms of your choice that,+taken together, effectively do not restrict modification of the+portions of the Library contained in the Combined Work and reverse+engineering for debugging such modifications, if you also do each of+the following:++ a) Give prominent notice with each copy of the Combined Work that+ the Library is used in it and that the Library and its use are+ covered by this License.++ b) Accompany the Combined Work with a copy of the GNU GPL and this license+ document.++ c) For a Combined Work that displays copyright notices during+ execution, include the copyright notice for the Library among+ these notices, as well as a reference directing the user to the+ copies of the GNU GPL and this license document.++ d) Do one of the following:++ 0) Convey the Minimal Corresponding Source under the terms of this+ License, and the Corresponding Application Code in a form+ suitable for, and under terms that permit, the user to+ recombine or relink the Application with a modified version of+ the Linked Version to produce a modified Combined Work, in the+ manner specified by section 6 of the GNU GPL for conveying+ Corresponding Source.++ 1) Use a suitable shared library mechanism for linking with the+ Library. A suitable mechanism is one that (a) uses at run time+ a copy of the Library already present on the user's computer+ system, and (b) will operate properly with a modified version+ of the Library that is interface-compatible with the Linked+ Version.++ e) Provide Installation Information, but only if you would otherwise+ be required to provide such information under section 6 of the+ GNU GPL, and only to the extent that such information is+ necessary to install and execute a modified version of the+ Combined Work produced by recombining or relinking the+ Application with a modified version of the Linked Version. (If+ you use option 4d0, the Installation Information must accompany+ the Minimal Corresponding Source and Corresponding Application+ Code. If you use option 4d1, you must provide the Installation+ Information in the manner specified by section 6 of the GNU GPL+ for conveying Corresponding Source.)++ 5. Combined Libraries.++ You may place library facilities that are a work based on the+Library side by side in a single library together with other library+facilities that are not Applications and are not covered by this+License, and convey such a combined library under terms of your+choice, if you do both of the following:++ a) Accompany the combined library with a copy of the same work based+ on the Library, uncombined with any other library facilities,+ conveyed under the terms of this License.++ b) Give prominent notice with the combined library that part of it+ is a work based on the Library, and explaining where to find the+ accompanying uncombined form of the same work.++ 6. Revised Versions of the GNU Lesser General Public License.++ The Free Software Foundation may publish revised and/or new versions+of the GNU Lesser General Public License from time to time. Such new+versions will be similar in spirit to the present version, but may+differ in detail to address new problems or concerns.++ Each version is given a distinguishing version number. If the+Library as you received it specifies that a certain numbered version+of the GNU Lesser General Public License "or any later version"+applies to it, you have the option of following the terms and+conditions either of that published version or of any later version+published by the Free Software Foundation. If the Library as you+received it does not specify a version number of the GNU Lesser+General Public License, you may choose any version of the GNU Lesser+General Public License ever published by the Free Software Foundation.++ If the Library as you received it specifies that a proxy can decide+whether future versions of the GNU Lesser General Public License shall+apply, that proxy's public statement of acceptance of any version is+permanent authorization for you to choose that version for the+Library.
+ README view
@@ -0,0 +1,97 @@+# -*- mode: org -*-+#+TITLE: hs-conllu++[[https://travis-ci.org/odanoburu/hs-conllu][file:https://travis-ci.org/odanoburu/hs-conllu.svg?branch=master]]++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+diffing functions are also provided.++further processing utilities are being developed and will be placed in+a separate package.++* installation+ #+BEGIN_SRC sh+ cd /path/of/choice/+ git clone $REPO_URL+ #+END_SRC+ - using =cabal=:+ #+BEGIN_SRC sh+ cabal install+ #+END_SRC+ - using =stack=:+ #+BEGIN_SRC sh+ stack setup+ stack build+ 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!).++ 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+ bounds were generated automatically by cabal, and are probably+ conservative -- the library probably will probably still work if you+ have the same major version. (if it does, make a PR!)++ if you don't want to have this kind of problem anymore, try [[https://docs.haskellstack.org/en/stable/README/][stack]]+ (see why [[https://www.fpcomplete.com/blog/2015/06/why-is-stack-not-cabal][here]]).++* usage+ if you would like to request features, please open an issue.++** hs-conllu, the executable+ this executable can be called using stack by+ : stack exec hs-conllu [subcommand] [args]+ it currently has two subcommands:+ - validate :: read and pretty-print the file given as argument.+ - diff :: diff the two CoNLL-U files provided as arguments, and+ print them. this assumes changes have only been made to+ word fields, not to sentence ordering, etc. if you'd like+ finer grained diffing, you will have to use the library.++** Reading CoNLL-U files+ the reading functions are in the =IO= module.+ #+BEGIN_SRC sh+ $ ghci+ > import Conllu.IO+ > d <- readConllu "path/to/conllu"+ #+END_SRC+ will read the file at the specified path, or all the =*.conllu=+ files in that path.++ if your CoNLL-U files don't stricly follow the specification or I+ got the parser wrong, please open an issue! aditionally, you may+ solve your problem if you take a look at the =Parser= module.++** Customizable parsers+ if you just want to tweak how a few fields of the CoNLL-U format+ are parsed, you may write a parser for that field and then+ customize the standard parser with it. see the Haddock+ documentation for the =Parse= module.++ I didn't make the parser as customizable as it could be, so if that+ bothers you, please create an issue or file a PR!++** Pretty-Printing+ the printing functions are in the =Print= module. see the Haddock+ documentation!++** 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+ library or my code.++ if you want to contribute code, let me know, and go right on. you+ may want to look at the =TODO.org= file.++* Footnotes++[fn:1] it currently only validates the CoNLL-U syntax, not its+semantics (i.e., it will report an error if it finds a letter on the+ID field, but won't complain if you specified an inexisting word as+HEAD of another word).
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ TODO view
@@ -0,0 +1,17 @@+# -*- 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)
+ hs-conllu.cabal view
@@ -0,0 +1,59 @@+name: hs-conllu+version: 0.1.2+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-file: LICENSE+author: bruno cuconato+maintainer: bruno cuconato <bcclaro+haskell+hsconllu@gmail.com>+category: Language+build-type: Simple+cabal-version: >=1.18+tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.1++source-repository head+ type: git+ location: https://github.com/odanoburu/hs-conllu.git++library+ exposed-modules: Conllu.Type,+ Conllu.UposTagset,+ Conllu.DeprelTagset,+ Conllu.IO,+ Conllu.Parse,+ 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
+ src/Conllu/DeprelTagset.hs view
@@ -0,0 +1,57 @@+-- |+-- Module : Conllu.DeprelTagset+-- Copyright : © 2018 bruno cuconato+-- License : LPGL-3+--+-- Maintainer : bruno cuconato <bcclaro+hackage@gmail.com>+-- Stability : experimental+-- Portability : non-portable+--+-- defines the CoNLL-U DEPREL tagset. this module is meant to be imported as+--+-- @+-- import qualified Conllu.DeprelTagset as D+-- @++module Conllu.DeprelTagset where++data EP+ = ACL+ | ADVCL+ | ADVMOD+ | AMOD+ | APPOS+ | AUX+ | CASE+ | CC+ | CCOMP+ | CLF+ | COMPOUND+ | CONJ+ | COP+ | CSUBJ+ | DEP+ | DET+ | DISCOURSE+ | DISLOCATED+ | EXPL+ | FIXED+ | FLAT+ | GOESWITH+ | IOBJ+ | LIST+ | MARK+ | NMOD+ | NSUBJ+ | NUMMOD+ | OBJ+ | OBL+ | ORPHAN+ | PARATAXIS+ | PUNCT+ | REF -- ^ only allowed in DEPS+ | REPARANDUM+ | ROOT+ | VOCATIVE+ | XCOMP+ deriving (Enum, Eq, Read, Show)
+ src/Conllu/Diff.hs view
@@ -0,0 +1,123 @@+-- |+-- Module : Conllu.Diff+-- Copyright : © 2018 bruno cuconato+-- License : LPGL-3+--+-- Maintainer : bruno cuconato <bcclaro+hackage@gmail.com>+-- Stability : experimental+-- Portability : non-portable+--+-- Build a diff of CoNLL-U elements (documents, sentences, words). it+-- may show the diff (the print* functions return pairs of the+-- differing fields in two words) or return the word pairs for further+-- processing (the diff* functions). it expects paired sentences as+-- input, and a default pairing function is provided.+--+-- this module is useful for visualizing or debugging the processing+-- of CoNLL-U corpora. be sure that the sentences are well-paired, or+-- else it'll be -- as always -- garbage in, garbage out.++module Conllu.Diff where++import Conllu.Type+import Conllu.Utils++import Data.Maybe+import Data.Ord++---+-- * type synonims+-- | CoNLL-U field diff.+type FDiff = StringPair++-- | pair of different words.+type WDiff a = (CW a, CW a)+-- | list of different words in a sentence.+type SDiff a = [WDiff a]+-- | list of lists of different words in sentences.+type DDiff a = [SDiff a]++---+-- * diffing functions+diffW :: WDiff a -> Bool+-- | 'True' if any word field pairs are mismatched.+diffW = any isJust . printFieldDiffs++diffWs :: [CW a] -> [CW a] -> [WDiff a]+-- | filters the different word pairs.+diffWs ws1 ws2 = filter diffW $ zip ws1 ws2++diffS :: (Sent, Sent) -> SDiff AW+-- | diffs the sentence pair's words.+diffS (s1, s2) = diffWs (_words s1) (_words s2)++diffSs :: [(Sent, Sent)] -> DDiff AW+-- | diffs the sentence pairs.+diffSs = fmap diffS++---+-- * auxiliary functions+showM :: Show a => Maybe a -> String+-- | shows a word field.+showM (Just x) = show x+showM Nothing = "_"++---+-- * pairing functions+pairSentsBy ::+ (Sent -> Sent -> Ordering) -> [Sent] -> [Sent] -> [(Sent, Sent)]+-- | pairs sentences by some ordering of 'Sent'.+pairSentsBy _f [] _ss = []+pairSentsBy _f _ss [] = []+pairSentsBy f ss1@(s1:st1) ss2@(s2:st2) =+ case f s1 s2 of+ LT -> pairSentsBy f st1 ss2+ GT -> pairSentsBy f ss1 st2+ EQ -> (s1, s2) : pairSentsBy f st1 st2++sentId :: Sent -> Maybe Index+-- | try to find an index in a sentence's metadata looking for+-- 'sent_id = n'.+sentId s =+ let mi = lookup "sent_id " $ _meta s+ i = fromMaybe "0" mi+ in safeRead i :: Maybe Index++pairSents :: [Sent] -> [Sent] -> [(Sent, Sent)]+-- | pair sentences by their sent_id, found in their metadata.+pairSents = pairSentsBy $ comparing sentId++---+-- * printing functions+printFieldDiffs :: WDiff a -> [Maybe StringPair]+-- | list of maybe differing fields in a pair of words.+printFieldDiffs (w1, w2) = fmap (diffField w1 w2) pfs+ where+ diffField w w' pf =+ let pf1 = pf w+ pf2 = pf w'+ in if pf1 /= pf2+ then Just (pf1, pf2)+ else Nothing+ pfs =+ [ showM . _form+ , showM . _lemma+ , showM . _upos+ , showM . _xpos+ , show . _feats+ , showM . _rel+ , show . _deps+ , showM . _misc+ ]++printWDiff :: WDiff a -> [StringPair]+-- | list of differing fields in a pair of words.+printWDiff = catMaybes . printFieldDiffs++printSDiff :: SDiff a -> [[StringPair]]+-- | list of differing words in a sentence.+printSDiff = fmap printWDiff++printDDiff :: DDiff a -> [[[StringPair]]]+-- | list of lists of differing words in sentences.+printDDiff = fmap printSDiff
+ src/Conllu/IO.hs view
@@ -0,0 +1,92 @@+-- |+-- Module : Conllu.IO+-- Copyright : © 2018 bruno cuconato+-- License : LPGL-3+--+-- Maintainer : bruno cuconato <bcclaro+hackage@gmail.com>+-- Stability : experimental+-- Portability : non-portable+--+-- Defines major IO functions.++module Conllu.IO where++---+-- imports+import Conllu.Type+import Conllu.Utils+import Conllu.Parse+import Conllu.Print+import Conllu.Diff++import System.Directory+import System.FilePath+++-- * read functions++---+-- ** readers using a customized parser+-- | these reader functions will read files using a customized+-- parser. you can build one with 'ParserC' and 'parserC'.+readConlluFileWith :: Parser Sent -> FilePath -> IO Doc+-- | reads a file with a customized parser.+readConlluFileWith p f = do+ ds <- readFile f+ case parseConlluWith p f ds of+ Left err -> putStr err *> return []+ Right d -> return d++readDirectoryWith :: Parser Sent -> FilePath -> IO [Doc]+-- | reads all the files in a directory as CoNLL-U files with a+-- customized parser.+readDirectoryWith p d = do fs' <- listDirectory d+ let fs = map (d </>) fs'+ mapM (readConlluFileWith p) fs++readConlluWith :: Parser Sent -> FilePath -> IO [Doc]+-- | reads a file or a directory as CoNLL-U files with a customized+-- parser.+readConlluWith p fp = do f <- doesFileExist fp+ if' f (mapM (readConlluFileWith p) [fp]) $+ do d <- doesDirectoryExist fp+ if' d (readDirectoryWith p fp) (return [])++---+-- ** readers using default parsers+readConlluFile :: FilePath -> IO Doc+-- | reads a CoNLL-U file.+readConlluFile = readConlluFileWith sentence++readDirectory :: FilePath -> IO [Doc]+-- | reads all files in a directory as CoNLL-U files.+readDirectory = readDirectoryWith sentence++readConllu :: FilePath -> IO [Doc]+-- | reads a file or a directory as CoNLL-U files.+readConllu = readConlluWith sentence++---+-- * write+writeConlluFile :: FilePath -> Doc -> IO ()+-- | writes a CoNLL-U file to disk.+writeConlluFile fp = writeFile fp . printDoc++---+-- * print+readAndPrintConllu :: FilePath -> IO ()+-- | reads and prints the CoNLL-U files given.+readAndPrintConllu fp = do+ readConlluFile fp >>= putStr . printDoc+ return ()++---+-- * diff+diffConllu :: FilePath -> FilePath -> IO ()+-- | reads two CoNLL-U files and prints their diffs. this assumes+-- their sentences are paired.+diffConllu fp1 fp2 = do+ ss1 <- readConlluFile fp1+ ss2 <- readConlluFile fp2+ print . printDDiff . diffSs $ zip ss1 ss2+ return ()
+ src/Conllu/Parse.hs view
@@ -0,0 +1,406 @@+-- |+-- Module : Conllu.Parse+-- Copyright : © 2018 bruno cuconato+-- License : LPGL-3+--+-- Maintainer : bruno cuconato <bcclaro+hackage@gmail.com>+-- Stability : experimental+-- Portability : non-portable+--+-- Parsers for CoNLL-U format. the CoNLL-U format is based in the+-- deprecated CoNLL format (defined+-- [here](https://web.archive.org/web/20161105025307/http://ilk.uvt.nl/conll/))+-- and is defined [here](http://universaldependencies.org/format.html)++module Conllu.Parse+ ( Parser+ -- * parsers+ , parseConlluWith+ , parseConllu+ -- * customizable parsers+ , ParserC(ParserC)+ , parserC+ -- * default parsers+ , rawSents+ , sentence+ , comment+ , word+ -- * CoNLL-U field parsers+ , emptyField+ , idW+ , form+ , lemma+ , upos+ , xpos+ , feats+ , deprel+ , deps+ , misc+ -- * utility parsers+ , commentPair+ , listPair+ , stringNot+ , stringWOSpaces+ , stringWSpaces+ -- * parser combinators+ , keyValue+ , maybeEmpty+ , orEmpty+ , listP )+where++---+-- imports+import Conllu.Type+import qualified Conllu.DeprelTagset as D+import qualified Conllu.UposTagset as U++import Control.Monad (void, liftM2)+import Data.Either+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 Text.Megaparsec.Char+import qualified Text.Megaparsec.Char.Lexer as L++-- | Parser type synonym+type Parser = Parsec Void String++-- | Parser raw output+type RawData t e = [Either (ParseError t e) Sent]++-- | DEPREL field type synonym+type DEPREL = Maybe (D.EP, Maybe String)+++---+-- conllu parsers+rawSents :: Parser (RawData Char Void)+-- | parse CoNLL-U sentences with recovery.+rawSents = rawSentsC sentence++rawSentsC :: Parser Sent -> Parser (RawData Char Void)+-- | parse CoNLL-U sentences with recovery, using a custom parser.+rawSentsC sent = between ws eof (e `endBy1` lineFeed)+ where+ e = withRecovery recover (Right <$> sent)+ recover err =+ Left err <$+ skipManyTill anyChar+ -- 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)++lineFeed :: Parser ()+-- | parse a blank line.+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+-- | the customizable sentence parser.+sentenceC c t = liftM2 Sent (many c) (some t)++comment :: Parser Comment+-- | parse a comment.+comment =+ (symbol "#" <?> "comment starter") *> commentPair <*+ lineFeed <?> "comment content"++word :: Parser (CW AW)+-- | the default word parser.+word =+ wordC idW form lemma upos xpos feats deprel deps misc++wordC ::+ Parser ID+ -> Parser FORM+ -> Parser LEMMA+ -> Parser UPOS+ -> Parser XPOS+ -> Parser FEATS+ -> Parser DEPREL+ -> Parser DEPS+ -> Parser MISC+ -> 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+ mup <- upp <* tab+ mxp <- xpp <* tab+ mfs <- fsp <* tab+ mdh <- dhp <* tab+ mdr <- drp <* tab+ ds <- dsp <* tab+ mm <- mp <* lineFeed+ return $ mkAW i mf ml mup mxp mfs (rel mdh mdr) ds mm+ where+ dhp = maybeEmpty ixp <?> "HEAD"+ rel :: Maybe ID -> DEPREL -> Maybe Rel+ rel mdh mdr = do+ dh <- mdh+ (dr, sdr) <- mdr+ return $ Rel dh dr sdr Nothing++emptyField :: Parser (Maybe a)+-- | parse an empty field.+emptyField = symbol "_" *> return Nothing <?> "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"+ return $+ case mix of+ Nothing -> SID ix+ Just (Left _, eix) -> MID ix eix+ Just (Right _, eix) -> EID ix eix+ where+ index :: Parser Index+ index = do+ ix <- some digitChar <?> "ID"+ return (read ix :: Int)+ indexSep :: Parser (Either IxSep IxSep)+ indexSep = eitherP (char '-') (char '.') <?> "meta separator"+ metaIndex :: Parser (Either IxSep IxSep, Index)+ metaIndex = do+ sep <- indexSep+ ix <- index+ return (sep, ix)++form :: Parser FORM+-- | parse the FORM field.+form = orEmpty stringWSpaces <?> "FORM"++lemma :: Parser LEMMA+-- | parse the LEMMA field.+lemma = orEmpty stringWSpaces <?> "LEMMA"++upos :: Parser UPOS+-- | parse the UPOS field.+upos = maybeEmpty upos' <?> "UPOS"+ where+ upos' :: Parser U.POS+ upos' = fmap mkUPOS stringWOSpaces++xpos :: Parser XPOS+-- | parse the XPOS field.+xpos = maybeEmpty stringWOSpaces <?> "XPOS"++feats :: Parser FEATS+-- | parse the FEATS field.+feats = listP (feat `sepBy` symbol "|" <?> "FEATS")+ where+ feat = do+ k <- lexeme (some alphaNumChar <?> "feature key")+ ft <-+ optional $+ between (symbol "[") (symbol "]") (some alphaNumChar)+ _ <- symbol "="+ vs <- fvalue `sepBy1` symbol ","+ return $ Feat k vs ft+ fvalue = lexeme (some alphaNumChar <?> "feature value")++deprel :: Parser DEPREL+-- | parse the DEPREL field.+deprel = maybeEmpty deprel'++dep :: Parser D.EP+dep = fmap mkDEP (letters <?> "DEPREL")++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")++deps :: Parser DEPS+-- | parse the DEPS field.+deps = listP (eDep `sepBy` symbol "|" <?> "DEPS")+ where+ eDep = do+ h <- idW <?> "enhanced dependency HEAD"+ _ <- sep+ d <- dep <?> "enhanced dependency DEPREL"+ restI <-+ optional+ (sep *>+ stringNot "\t| :" `sepBy` sep <?>+ "enhanced dependency information")+ return $ Rel h d Nothing restI+ sep = symbol ":"++misc :: Parser MISC+-- | parse the MISC field.+misc = orEmpty stringWSpaces <?> "MISC"++---+-- utility parsers+commentPair :: Parser Comment+-- | parse a comment pair.+commentPair =+ keyValue "=" (stringNot "=\n\t") (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 "|"++stringNot :: String -> Parser String+-- | parse any chars except the ones provided.+stringNot s = lexeme . some $ satisfy (`notElem` s)++stringWOSpaces :: Parser String+-- | parse a string until a space, a tab, or a newline.+stringWOSpaces = stringNot " \t\n"++stringWSpaces :: Parser String+-- | parse a string until a tab or a newline.+stringWSpaces = stringNot "\t\n"++letters :: Parser String+-- | parse a string of letters.+letters = lexeme $ some letterChar++---+-- parser combinators+keyValue :: String -> Parser a -> Parser b -> Parser (a, b)+-- | parse a (key, value) pair.+keyValue sep p q = do+ key <- p+ _ <- optional $ symbol sep+ value <- q+ return (key, value)+++-- | two combinators are needed for parsing the empty field (without+-- lookahead). this has to do with the fact that if we do+--+-- > form <|> emptyField+--+-- we would parse "_" as a non-empty FORM field. but if we did+--+-- > emptyField <|> form+--+-- we would parse "_" in "_something" and then the parser would choke+-- expecting a tab.++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++orEmpty :: Parser String -> Parser (Maybe String)+-- | a parser combinator for parsers that may parse "_".+orEmpty p = do+ r <- p+ case r of+ "_" -> return Nothing+ _ -> return $ Just r++listP :: Parser [a] -> Parser [a]+-- | parse a list of values that may be an empty field. using a parser+-- that returns a possibly empty list like 'sepBy' and many will+-- return the correct result for the empty field ('_'), but will+-- report it the same as any other syntax error.+listP p = fromMaybe [] <$> maybeEmpty p++---+-- lexing+symbol :: String -> Parser String+symbol = L.symbol ws++lexeme :: Parser a -> Parser a+lexeme = L.lexeme ws++ws :: Parser ()+ws = void $ takeWhileP (Just "space") (== ' ')++---+-- customizable parser+data ParserC = ParserC+ { _commentP :: Parser Comment+ , _idP :: Parser ID+ , _formP :: Parser FORM+ , _lemmaP :: Parser LEMMA+ , _upostagP :: Parser UPOS+ , _xpostagP :: Parser XPOS+ , _featsP :: Parser FEATS+ , _deprelP :: Parser DEPREL+ , _depsP :: Parser DEPS+ , _miscP :: Parser MISC+ } deriving ()++customC :: ParserC+customC = ParserC+ { _commentP = comment+ , _idP = idW+ , _formP = form+ , _lemmaP = lemma+ , _upostagP = upos+ , _xpostagP = xpos+ , _featsP = feats+ , _deprelP = deprel+ , _depsP = deps+ , _miscP = misc+ }++parserC :: ParserC -> Parser Sent+-- | defines a custom parser of sentences. if you only need to+-- customize one field parser (e.g., to parse special comments or a+-- special MISC field), you can do:+--+-- @+-- parserC ParserC{_commentP = myCommentsParser }+-- @+parserC p =+ let i = _idP p+ f = _formP p+ l = _lemmaP p+ up = _upostagP p+ xp = _xpostagP p+ fs = _featsP p+ dr = _deprelP p+ ds = _depsP p+ m = _miscP p+ c = _commentP p+ w = wordC i f l up xp fs dr ds m+ s = sentenceC c w+ in s++---+-- parse+parseConlluWith+ :: Parser Sent -- ^ the sentence parser to be used.+ -> FilePath -- ^ the source whose stream is being supplied in the+ -- next argument (may be "" for no file)+ -> String -- ^ stream to be parsed+ -> 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 ->+ let (ls, rs) = partitionEithers d+ in if null ls+ then Right rs+ else Left $ concatMap parseErrorPretty ls+ where+ doc = rawSentsC p++parseConllu :: FilePath -> String -> Either String Doc+-- | parse a CoNLL-U document using the default parser.+parseConllu = parseConlluWith sentence
+ src/Conllu/Print.hs view
@@ -0,0 +1,159 @@+-- |+-- Module : Conllu.Print+-- Copyright : © 2018 bruno cuconato+-- License : LPGL-3+--+-- Maintainer : bruno cuconato <bcclaro+hackage@gmail.com>+-- Stability : experimental+-- Portability : non-portable+--+-- prints CoNLL-U.++module Conllu.Print+ ( printDoc+ , printSent )+where++import qualified Conllu.DeprelTagset as D+import Conllu.Type+import Conllu.Utils++import Data.List+import Data.Maybe+import Data.Semigroup+import Data.Monoid (Monoid(mempty, mappend))++-- TODO: use some kind of bi-directional thing to derive this module++-- | Functional list type from LYHGG, see HUGHES, RJM. "A novel+-- representation of lists and its application to the function+-- 'reverse'"+newtype FList a = FList { getFList :: [a] -> [a] }++instance Semigroup (FList a) where+ (FList f) <> (FList g) = FList (f . g)++instance Monoid (FList a) where+ mempty = FList (\xs -> [] ++ xs)+ a `mappend` b = a <> b++toFList :: [a] -> FList a+toFList xs = FList (xs++)++fromFList :: FList a -> [a]+fromFList (FList f) = f []++---+-- printing+printDoc :: Doc -> String+-- | prints a list of sentences to a string.+printDoc =+ fromFList . mconcat . map (\s -> printSent' s `mappend` diffLSpace)++printSent :: Sent -> String+-- | prints a sentence to a string.+printSent = fromFList . printSent'++printSent' :: Sent -> FList Char+printSent' ss =+ mconcat+ [ printComments (_meta ss)+ , diffLSpace+ , printWs (_words ss)+ ]++printComments :: [Comment] -> FList Char+printComments =+ toFList .+ intercalate "\n" .+ map+ (\(c1, c2) ->+ concat+ [ "# "+ , c1+ , if null c2+ then ""+ else "= " ++ c2+ ])++printWs :: [CW a] -> FList Char+printWs = foldr (\w dl -> mconcat [printW w, diffLSpace, dl]) mempty++printW :: CW a -> FList Char+printW = printW'+ where+ printW' :: CW a -> FList Char+ printW' w =+ wordLine w+ [ printID'+ , printFORM+ , printLEMMA+ , printUPOS'+ , printXPOS+ , printFEATS'+ , printHEAD+ , printDEPREL'+ , printDEPS'+ , printMISC+ ]+ wordLine :: CW a -> [CW a -> String] -> FList Char+ wordLine w = toFList . intercalate "\t" . map (\f -> f w)+ printID' = printID . _id+ printMStr = fromMaybe "_"+ printFORM = printMStr . _form+ printLEMMA = printMStr . _lemma+ printUPOS' = printUPOS . _upos+ printXPOS = printMStr . _xpos+ printFEATS' = printFEATS . _feats+ printHEAD = maybe "_" (printID . _head) . _rel+ printDEPREL' =+ maybe "_" (\r -> printDEPREL (_deprel r) (_subdep r)) . _rel+ printDEPS' = printDEPS . _deps+ printMISC = printMStr . _misc++---+-- field printers+printID :: ID -> String+printID id' =+ case id' of+ SID i -> show i+ MID s e -> concat [show s, "-", show e]+ EID i e -> concat [show i, ".", show e]++printUPOS :: UPOS -> String+printUPOS Nothing = "_"+printUPOS (Just pos) = show pos++printFEATS :: FEATS -> String+printFEATS = printList printFeat+ where+ printFeat Feat {_feat = f, _featValues = vs, _featType = mft} =+ let fts = maybe "" (\ft -> "[" ++ ft ++ "]") mft+ in concat [f, fts, "=", intercalate "," vs]++printDEPREL :: D.EP -> Maybe String -> String+printDEPREL dr sdr =+ downcaseStr $ show dr ++ maybe "" (":" ++) sdr++printDEPS :: DEPS -> String+printDEPS =+ printList+ (\r ->+ intercalate+ ":"+ ([printID (_head r), printDEPREL (_deprel r) (_subdep r)] +++ fromMaybe [] (_rest r)))++---+-- utility printers+printList :: (a -> String) -> [a] -> String+printList f = nullToStr . intercalate "|" . map f+ where+ nullToStr :: String -> String+ nullToStr xs =+ if null xs+ then "_"+ else xs++diffLSpace :: FList Char+diffLSpace = toFList "\n"
+ src/Conllu/Type.hs view
@@ -0,0 +1,192 @@+-- |+-- Module : Conllu.Type+-- Copyright : © 2018 bruno cuconato+-- License : LPGL-3+--+-- Maintainer : bruno cuconato <bcclaro+hackage@gmail.com>+-- Stability : experimental+-- Portability : non-portable+--+-- defines types for handling CoNLL-U data.++{-# LANGUAGE EmptyDataDecls #-}++module Conllu.Type where++---+-- imports+import Conllu.Utils+import qualified Conllu.UposTagset as U+import qualified Conllu.DeprelTagset as D++import Data.Ord++---+-- * type and data declarations+-- ** Documents and Sentences+type Doc = [Sent]++data Sent = Sent+ { _meta :: [Comment] -- ^ the sentence's comments.+ , _words :: [CW AW] -- ^ the sentence's words.+ } deriving (Eq, Show)++-- | most comments are (key, value) pairs.+type Comment = StringPair+type StringPair = (String, String)++-- ** Words+-- | represents a word line in a CoNLL-U file. note that we have+-- collapsed some fields together: 'HEAD' and DEPREL have been+-- combined as a relation type Rel accessible by the '_rel' function;+-- the 'DEPS' field is merely a list of 'Rel'.+--+-- a C(oNLL-U)W(ord) may be a simple word, a multi-word token, or an+-- empty node. this is captured by the phantom type (the `a` in the+-- declaration), which can be parametrized by one of the data types+-- below in order to build functions that only operate on one of these+-- word types (see 'mkSWord' on how to do this). see the '_dep'+-- function, which only operates on simple words, which are the ones+-- that have a DEPREL field.+data CW a = CW+ { _id :: ID -- ^ ID field+ , _form :: FORM -- ^ FORM field+ , _lemma :: LEMMA -- ^ LEMMA field+ , _upos :: UPOS -- ^ UPOS field+ , _xpos :: XPOS -- ^ XPOS field+ , _feats :: FEATS -- ^ FEATS field+ , _rel :: Maybe Rel -- ^ combined HEAD and DEPREL fields+ , _deps :: DEPS -- ^ DEPS field+ , _misc :: MISC -- ^ MISC field+ } deriving (Eq, Show)++instance Ord (CW a) where+ compare = comparing _id++-- *** Word types+-- | phantom type for any kind of word.+data AW+-- | phantom type for a simple word.+data SW+-- | phantom type for multiword tokens. do note that in MWTs only the+-- 'ID', 'FORM' and 'MISC' fields may be non-empty.+data MT+-- | phantom type for an empty node.+data EN++-- *** Word Fields+data ID -- | Word ID field.+ = SID Index -- ^ word ID is an integer+ | MID Index+ Index -- ^ multi-word token ID is a range+ | EID Index+ Index -- ^ empty node ID is a decimal+ deriving (Eq, Show)++instance Ord ID where+ compare = idOrd+ where+ idOrd :: ID -> ID -> Ordering+ idOrd id1 id2 =+ let c = comparing fstIx id1 id2+ in case c of+ EQ -> sameIx id1 id2+ _ -> c+ where+ fstIx :: ID -> Index+ fstIx (SID i) = i+ fstIx (MID i _ei) = i+ fstIx (EID i _ei) = i+ sndIx :: ID -> Index+ sndIx (EID _s e) = e+ sndIx (MID _s e) = e+ sameIx :: ID -> ID -> Ordering+ sameIx (SID _) _id = GT+ sameIx _id (SID _) = LT+ -- reverse ID order so that MID 1 4 comes before MID 1 2:+ sameIx i1 i2 = comparing sndIx i2 i1++type FORM = Maybe String+type LEMMA = Maybe String+type UPOS = Maybe U.POS+type XPOS = Maybe String+type FEATS = [Feat]+type HEAD = ID+type DEPS = [Rel]+type MISC = Maybe String++-- | feature representation+data Feat = Feat+ { _feat :: String -- ^ feature name+ , _featValues :: [String] -- ^ feature values+ , _featType :: Maybe String -- ^ feature type (inside brackets).+ } deriving (Eq, Show) -- add manual Ord instance?++-- | dependency relation representation.+data Rel = Rel+ { _head :: HEAD -- ^ head 'ID'+ , _deprel :: D.EP -- ^ dependency relation type+ , _subdep :: Maybe String -- ^ dependency relation subtype+ , _rest :: Maybe [String] -- ^ provisitonal, see issues #23,#17+ } deriving (Eq, Show)++type Index = Int+-- | 'ID' separator in meta words+type IxSep = Char++---+-- ** accessor functions+_dep :: CW SW -> Maybe D.EP+-- | get DEPREL main value, if it exists.+_dep w = Just . _deprel =<< _rel w++depIs :: D.EP -> CW SW -> Bool+-- | check if DEP is the one provided.+depIs d = maybe False (\d' -> d == d') . _dep++---+-- ** constructor functions+mkDEP :: String -> D.EP+-- | read a main DEPREL (no subtype).+mkDEP = read . upcaseStr++mkUPOS :: String -> U.POS+-- | read an 'UPOS' tag.+mkUPOS = read . upcaseStr++-- words+mkAW :: ID -> FORM -> LEMMA -> UPOS -> XPOS -> FEATS -> Maybe Rel+ -> DEPS -> MISC -> CW AW+-- | make a word from its fields, by default it has phantom type of AW+-- (any kind of word).+mkAW = CW++mkSW :: CW AW -> CW SW+-- | coerce a word to a simple word.+mkSW CW { _id = i+ , _form = f+ , _lemma = l+ , _upos = u+ , _xpos = x+ , _feats = fs+ , _rel = r+ , _deps = ds+ , _misc = m+ } = CW i f l u x fs r ds m++{-- saved for a future validation module+---+-- validation+mTkOK :: FORM -> LEMMA -> UPOS -> XPOS -> FEATS -> (ID, (Dep, Maybe String))+ -> Bool+mTkOK fo l up xp fe h dr d =+ assSomething fo $+ assNothing l $+ assNothing up $+ assNothing xp $+ assNull fe $ assNothing h $ assNothing dr $ assNull d True++eTkOK :: Dephead -> DepRel -> Deps -> Bool+eTkOK h dr d =+ assNothing h $ assNothing dr $ (assert . not . null $ d) True+--}
+ src/Conllu/UposTagset.hs view
@@ -0,0 +1,36 @@+-- |+-- Module : Conllu.UposTagset+-- Copyright : © 2018 bruno cuconato+-- License : LPGL-3+--+-- Maintainer : bruno cuconato <bcclaro+hackage@gmail.com>+-- Stability : experimental+-- Portability : non-portable+--+-- defines the CoNLL-U UPOS tagset. this module is meant to be imported as+--+-- @+-- import qualified Conllu.UposTagset as U+-- @++module Conllu.UposTagset where++data POS+ = ADJ+ | ADP+ | ADV+ | AUX+ | CCONJ+ | DET+ | INTJ+ | NOUN+ | NUM+ | PART+ | PRON+ | PROPN+ | PUNCT+ | SCONJ+ | SYM+ | VERB+ | X+ deriving (Enum, Eq, Read, Show)
+ src/Conllu/Utils.hs view
@@ -0,0 +1,57 @@+-- |+-- Module : Conllu.Utils+-- Copyright : © 2018 bruno cuconato+-- License : LPGL-3+--+-- Maintainer : bruno cuconato <bcclaro+hackage@gmail.com>+-- Stability : experimental+-- Portability : non-portable+--+-- the library's utility functions.++module Conllu.Utils where++import Control.Exception.Base+import Data.Char+import Data.Maybe++---+-- char functions+upcaseStr :: String -> String+upcaseStr = map toUpper++downcaseStr :: String -> String+downcaseStr = map toLower++---+-- assertions+assNothing :: Maybe a -> Bool -> Bool+assNothing m = assert (isNothing m)++assSomething :: Maybe a -> Bool -> Bool+assSomething m = assert (isJust m)++assNull :: [a] -> Bool -> Bool+assNull l = assert (null l)++---+-- function tools+if' :: Bool -> a -> a -> a+if' True x _b = x+if' False _b y = y++consIf :: (a -> Bool) -> a -> [a] -> [a]+-- | cons value if it satisfies the predicate, else do nothing.+consIf p a as =+ if p a+ then a : as+ else as++---+-- safe functions+safehead :: [a] -> Maybe a+safehead [] = Nothing+safehead (x:_) = Just x++safeRead :: Read a => String -> Maybe a+safeRead = fmap fst . listToMaybe . reads
+ src/Main.hs view
@@ -0,0 +1,29 @@+-- |+-- Module : Main+-- Copyright : © 2018 bruno cuconato+-- License : LPGL-3+--+-- Maintainer : bruno cuconato <bcclaro+hackage@gmail.com>+-- Stability : experimental+-- Portability : non-portable+--+-- the @hs-conllu@ executable.++module Main+ ( main )+where++import Conllu.IO (readAndPrintConllu, diffConllu)++import System.Environment++main :: IO ()+-- | @validate@ : read CoNLL-U file and print it to stdout. (this will+-- only apply the command to one file, so use your terminal's+-- completion mechanism to apply it to several files.+main = do+ (c:as) <- getArgs+ case c of+ "validate" -> mapM_ readAndPrintConllu as+ "diff" -> diffConllu (as !! 0) (as !! 1)+ _ -> return ()