packages feed

nkjp (empty) → 0.1.0

raw patch · 7 files changed

+442/−0 lines, 7 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, data-named, filepath, polysoup, tar, text, zlib

Files

+ Data/NKJP/Morphosyntax.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE DeriveFunctor #-}++-- | Data types for the morphosytnax layer of the NKJP corpus.++module Data.NKJP.Morphosyntax+( Para (..)+, Sent (..)+, Seg (..)+, Lex (..)+) where++-- | A paragraph.+data Para t = Para+    { paraID    :: t+    , sentences :: [Sent t] }+    deriving (Show, Functor)++-- | A sentence.+data Sent t = Sent+    { sentID    :: t+    , segments  :: [Seg t] }+    deriving (Show, Functor)++-- | A segment.+data Seg t = Seg+    { segID     :: t +    , orth      :: t+    , nps       :: Bool+    , lexs      :: [Lex t]+    , choice    :: (t, t) }+    deriving (Show, Functor)++-- | A lexciacal entry, potential interpretation of the segment.+data Lex t = Lex+    { lexID     :: t+    , base      :: t+    , ctag      :: t+    , msds      :: [(t, t)] }+    deriving (Show, Functor)
+ Data/NKJP/Named.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE RecordWildCards #-}++-- | Data types for the named entities layer of the NKJP corpus.++module Data.NKJP.Named+( Cert (..)+, Ptr (..)+, Deriv (..)+, Para (..)+, Sent (..)+, NE (..)+, mkForest+) where++import Data.Named.Graph (toForest, mkGraph)+import Data.Named.Tree (mapTrees)+import Data.NKJP.Morphosyntax (Seg, segID)+import qualified Data.Map as M+import qualified Data.Tree as T++-- | A certainty of an annotator.+data Cert+    = High+    | Medium+    | Low+    deriving (Show)++-- | A pointer.+data Ptr t+    -- | Of #id form.+    = Local+        { target    :: t }+    -- | Of loc#id form.+    | Global+        { target    :: t+        , location  :: t }+    deriving (Show, Functor)++-- | A derivation structure.+data Deriv t = Deriv+    { derivType :: t +    , derivFrom :: t }+    deriving (Show, Functor)++-- | A paragraph.+data Para t = Para+    { paraID    :: t+    , sentences :: [Sent t] }+    deriving (Show, Functor)++-- | A sentence.+data Sent t = Sent+    { sentID    :: t+    , names     :: [NE t] }+    deriving (Show, Functor)++-- | A segment element in a file. +data NE t = NE+    { neID          :: t+    , derived       :: Maybe (Deriv t)+    , neType        :: t+    , subType       :: Maybe t+    , orth          :: t+    -- | Left base or Right when.+    , base          :: Either t t+    , cert          :: Cert+    , certComment   :: Maybe t+    , ptrs          :: [Ptr t] }+    deriving (Show)++instance Functor NE where+    fmap f NE{..} = NE+        { neID          = f neID+        , derived       = fmap (fmap f) derived+        , neType        = f neType+        , subType       = fmap f subType+        , orth          = f orth+        , base          = case base of+            Left x  -> Left  (f x)+            Right x -> Right (f x)+        , cert          = cert+        , certComment   = fmap f certComment+        , ptrs          = map (fmap f) ptrs }++-- | Make NE forest from a segment list and a list of NEs, both lists+-- corresponding to the same sentence.+mkForest :: Ord t => [Seg t] -> [NE t] -> T.Forest (Either (NE t) (Seg t))+mkForest xs ns =+    mapTrees decode (toForest graph)+  where+    -- Position of segment ID+    pos  = (M.!) $ M.fromList (zip (map segID xs) [0..])+    -- Segment on the given position+    word = (M.!) $ M.fromList (zip [0..] xs)+    -- NE with given ID+    name = (M.!) $ M.fromList [(neID ne, ne) | ne <- ns]++    graph  = mkGraph (0, length xs - 1)+        [ ( neID ne+          , map resolve (ptrs ne) )+        | ne <- ns ]++    resolve (Local ptr)    = Left ptr+    resolve (Global ptr _) = Right (pos ptr)++    decode (Left neID) = Left (name neID)+    decode (Right k)   = Right (word k)
+ LICENSE view
@@ -0,0 +1,26 @@+Copyright (c) 2012, IPI PAN+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.++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.
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ Text/NKJP/Morphosyntax.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Parsing the NKJP morphosyntax layer.++module Text.NKJP.Morphosyntax+( parseMorph+, readMorph+, readCorpus+, module Data.NKJP.Morphosyntax+) where++import System.FilePath (takeBaseName)+import Data.Maybe (isJust)+import qualified Data.Text.Lazy as L+import qualified Data.Text.Lazy.IO as L+import qualified Data.Text.Lazy.Encoding as L+import qualified Data.ByteString.Lazy as BS+import qualified Codec.Compression.GZip as GZip+import qualified Codec.Archive.Tar as Tar++import Text.XML.PolySoup+import Data.NKJP.Morphosyntax++-- | TEI NKJP ann_morphosyntax parser.+type P a = XmlParser L.Text a++morphP :: P [Para L.Text]+morphP = true //> paraP++paraP :: P (Para L.Text)+paraP = uncurry Para <$> (tag "p" *> getAttr "xml:id" </> sentP)++sentP :: P (Sent L.Text)+sentP = uncurry Sent <$> (tag "s" *> getAttr "xml:id" </> segP)++segP :: P (Seg L.Text)+segP = (tag "seg" *> getAttr "xml:id") `join` smP++smP :: L.Text -> P (Seg L.Text)+smP _segID = (tag "fs" *> hasAttr "type" "morph") `joinR` ( Seg+    <$> pure _segID+    <*> fStrP "orth"+    <*> (isJust <$> (optional . cut $ hasAttr "name" "nps"))+    <*> (hasAttr "name" "interps" /> lexP)+    <*> choiceP )++lexP :: P (Lex L.Text)+lexP = (hasAttr "type" "lex" *> getAttr "xml:id") `join` \_lexID -> ( Lex+    <$> pure _lexID+    <*> fStrP "base"+    <*> fSymP "ctag"+    <*> (hasAttr "name" "msd" //> cut+        ((,) <$> (tag "symbol" *> getAttr "xml:id") <*> getAttr "value")) )++choiceP :: P (L.Text, L.Text)+choiceP = hasAttr "name" "disamb" `joinR` ( tag "fs" `joinR` do+    ptr <- L.tail <$> cut (getAttr "fVal")+    interp <- fStrP "interpretation"+    return (ptr, interp) )++fStrP :: L.Text -> P L.Text+fStrP x =+    let checkName = tag "f" *> hasAttr "name" x+        -- | Body sometimes is empty.+        safeHead [] = ""+        safeHead xs = head xs+    in  safeHead <$> (checkName #> tag "string" /> text)++fSymP :: L.Text -> P L.Text+fSymP x =+    let checkName = tag "f" *> hasAttr "name" x+        p = cut (tag "symbol" *> getAttr "value")+    in  head <$> (checkName /> p)++-- | Parse textual contents of the ann_morphosyntax.xml file.+parseMorph :: L.Text -> [Para L.Text]+parseMorph = parseXml morphP++-- | Parse the stand-alone ann_morphosyntax.xml file.+readMorph :: FilePath -> IO [Para L.Text]+readMorph morphPath = parseMorph <$> L.readFile morphPath++-- | Parse NCP the .tar.gz corpus.+readCorpus :: FilePath -> IO [(FilePath, [Para L.Text])]+readCorpus tarPath = do+    map parseEntry . withBase "ann_morphosyntax" <$> readTar tarPath++readTar :: FilePath -> IO [Tar.Entry]+readTar tar+    =  Tar.foldEntries (:) [] error+    .  Tar.read . GZip.decompress+   <$> BS.readFile tar++parseEntry :: Tar.Entry -> (FilePath, [Para L.Text])+parseEntry entry =+    (Tar.entryPath entry, parseMorph content)+  where+    (Tar.NormalFile binary _) = Tar.entryContent entry+    content = L.decodeUtf8 binary++withBase :: String -> [Tar.Entry] -> [Tar.Entry]+withBase baseName = filter ((==baseName) . takeBaseName . Tar.entryPath)
+ Text/NKJP/Named.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Parsing the NKJP named entity layer.++module Text.NKJP.Named+( parseNamed+, readNamed+, readCorpus+, module Data.NKJP.Named+) where++import System.FilePath (takeBaseName)+import qualified Data.Text.Lazy as L+import qualified Data.Text.Lazy.IO as L+import qualified Data.Text.Lazy.Encoding as L+import qualified Data.ByteString.Lazy as BS+import qualified Codec.Compression.GZip as GZip+import qualified Codec.Archive.Tar as Tar++import Text.XML.PolySoup+import Data.NKJP.Named++-- | TEI NKJP ann_morphosyntax parser.+type P a = XmlParser L.Text a++namedP :: P [Para L.Text]+namedP = true //> paraP++paraP :: P (Para L.Text)+paraP = uncurry Para <$> (tag "p" *> getAttr "xml:id" </> sentP)++sentP :: P (Sent L.Text)+sentP = uncurry Sent <$> (tag "s" *> getAttr "xml:id" </> nameP)++nameP :: P (NE L.Text)+nameP = (tag "seg" *> getAttr "xml:id") `join` \_neID -> do+    ne <- nameBodyP+    _ptrs <- some namePtrP+         <|> failBad ("no targets specified for " ++ L.unpack _neID)+    return $ ne { neID = _neID, ptrs = _ptrs }++nameBodyP :: P (NE L.Text)+nameBodyP = (tag "fs" *> hasAttr "type" "named") `joinR` do+    _deriv   <- optional derivP+    _neType  <- fSymP "type"+    _subType <- optional (fSymP "subtype")+    _orth    <- fStrP "orth"+    _base    <- (Left  <$> fStrP "base") <|> (Right <$> fStrP "when")+    _cert    <- certP+    _certComment <- optional (fStrP "comment")+    return $ NE { neType = _neType, subType = _subType, orth = _orth+                , base = _base, derived = _deriv, cert = _cert+                , certComment = _certComment, neID = "", ptrs = [] }++derivP :: P (Deriv L.Text)+derivP = fP "derived" `joinR` ( fsP "derivation" `joinR` do+    Deriv <$> fSymP "derivType" <*> fStrP "derivedFrom" )+    +fP :: L.Text -> TagPred L.Text ()+fP x  = tag "f"  *> hasAttr "name" x++fsP :: L.Text -> TagPred L.Text ()+fsP x = tag "fs" *> hasAttr "type" x++certP :: P Cert+certP =+    mkCert <$> fSymP "certainty"+  where+    mkCert "high"   = High+    mkCert "medium" = Medium+    mkCert "low"    = Low+    mkCert _        = Medium    -- It should not happen!++namePtrP :: P (Ptr L.Text)+namePtrP = cut (tag "ptr" *> getAttr "target") >>= \x -> return $+    case L.break (=='#') x of+        (ptr, "")   -> Local ptr+        (loc, ptr)  -> Global+            { location = loc+            , target = (L.tail ptr) }++fStrP :: L.Text -> P L.Text+fStrP x =+    let checkName = tag "f" *> hasAttr "name" x+        -- Body sometimes is empty.+        safeHead [] = ""+        safeHead xs = head xs+    in  safeHead <$> (checkName #> tag "string" /> text)++fSymP :: L.Text -> P L.Text+fSymP x =+    let checkName = tag "f" *> hasAttr "name" x+        p = cut (tag "symbol" *> getAttr "value")+    in  head <$> (checkName /> p)++-- | Parse textual contents of the ann_named.xml file.+parseNamed :: L.Text -> [Para L.Text]+parseNamed = parseXml namedP++-- | Parse the stand-alone ann_named.xml file.+readNamed :: FilePath -> IO [Para L.Text]+readNamed namedPath = parseNamed <$> L.readFile namedPath++-- | Parse the NCP .tar.gz file.+readCorpus :: FilePath -> IO [(FilePath, [Para L.Text])]+readCorpus tarPath = do+    map parseEntry . withBase "ann_named" <$> readTar tarPath++readTar :: FilePath -> IO [Tar.Entry]+readTar tar+    =  Tar.foldEntries (:) [] error+    .  Tar.read . GZip.decompress+   <$> BS.readFile tar++parseEntry :: Tar.Entry -> (FilePath, [Para L.Text])+parseEntry entry =+    (Tar.entryPath entry, parseNamed content)+  where+    (Tar.NormalFile binary _) = Tar.entryContent entry+    content = L.decodeUtf8 binary++withBase :: String -> [Tar.Entry] -> [Tar.Entry]+withBase baseName = filter ((==baseName) . takeBaseName . Tar.entryPath)
+ nkjp.cabal view
@@ -0,0 +1,40 @@+name:               nkjp+version:            0.1.0+synopsis:           Manipulating the National Corpus of Polish (NKJP)+description:+    The library provides parsing and printing utilities for the+    National Corpus of Polish (NKJP).+license:            BSD3+license-file:       LICENSE+cabal-version:      >= 1.6+copyright:          Copyright (c) 2012 IPI PAN+author:             Jakub Waszczuk+maintainer:         waszczuk.kuba@gmail.com+stability:          experimental+category:           Natural Language Processing+homepage:           https://github.com/kawu/nkjp+build-type:         Simple++library+    build-depends:+        base >= 4 && < 5+      , containers+      , text+      , polysoup+      , bytestring+      , zlib+      , tar+      , filepath+      , data-named++    exposed-modules:+        Data.NKJP.Morphosyntax+      , Data.NKJP.Named+      , Text.NKJP.Morphosyntax+      , Text.NKJP.Named++    ghc-options: -Wall++source-repository head+    type: git+    location: git://github.com/kawu/nkjp.git