packages feed

nkjp 0.1.1 → 0.2.0

raw patch · 7 files changed

+260/−205 lines, 7 filesdep ~data-namednew-component:exe:named2enamex

Dependency ranges changed: data-named

Files

− Data/NKJP/Morphosyntax.hs 
@@ -1,39 +0,0 @@-{-# 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 
@@ -1,108 +0,0 @@-{-# 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)
Text/NKJP/Morphosyntax.hs view
@@ -1,26 +1,58 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveFunctor #-}  -- | Parsing the NKJP morphosyntax layer.  module Text.NKJP.Morphosyntax-( parseMorph+(+-- * Data types+  Para (..)+, Sent (..)+, Seg (..)+, Lex (..)++-- * Parsing+, 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+import qualified Text.NKJP.Tar as Tar +-- | 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)+ -- | TEI NKJP ann_morphosyntax parser. type P a = XmlParser L.Text a @@ -80,23 +112,8 @@ 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 . show)-    .  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)+-- | Parse all ann_morphosyntax.xml files from the NCP .tar.gz file.+-- Directories will be processed in an ascending order (with+-- respect to directory names).+readCorpus :: FilePath -> IO [(FilePath, Maybe [Para L.Text])]+readCorpus = Tar.readCorpus "ann_morphosyntax" parseMorph
Text/NKJP/Named.hs view
@@ -1,25 +1,130 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE RecordWildCards #-}  -- | Parsing the NKJP named entity layer.  module Text.NKJP.Named-( parseNamed+(+-- * Data types+  Cert (..)+, Ptr (..)+, Deriv (..)+, Para (..)+, Sent (..)+, NE (..)++-- * Parsing+, parseNamed , readNamed , readCorpus-, module Data.NKJP.Named+, readTrees++-- * Utilities+, mkForest ) where -import System.FilePath (takeBaseName)+import Data.Maybe (mapMaybe)+import qualified Data.Map as M+import qualified Data.Tree as T 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+import qualified Data.Named.Graph as Nd+import qualified Data.Named.Tree as Nd+import qualified Text.NKJP.Tar as Tar+import qualified Text.NKJP.Morphosyntax as Mx +-- | 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 => [Mx.Seg t] -> [NE t]+         -> T.Forest (Either (NE t) (Mx.Seg t))+mkForest xs ns =+    Nd.mapForest decode (Nd.toForest graph)+  where+    -- Position of segment ID+    pos  = (M.!) $ M.fromList (zip (map Mx.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  = Nd.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)+ -- | TEI NKJP ann_morphosyntax parser. type P a = XmlParser L.Text a @@ -101,23 +206,28 @@ 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 . show)-    .  Tar.read . GZip.decompress-   <$> BS.readFile tar+-- | Parse all ann_named.xml files from the NCP .tar.gz file.+-- Directories will be processed in an ascending order (with+-- respect to directory names).+readCorpus :: FilePath -> IO [(FilePath, Maybe [Para L.Text])]+readCorpus = Tar.readCorpus "ann_named" parseNamed -parseEntry :: Tar.Entry -> (FilePath, [Para L.Text])-parseEntry entry =-    (Tar.entryPath entry, parseNamed content)+-- | Parse the NCP .tar.gz corpus, extract all NEs and translate them+-- to the tree form using the 'mkForest' function. +readTrees :: FilePath -> IO [T.Forest (Either (NE L.Text) (Mx.Seg L.Text))]+readTrees path = do+    morph <- Mx.readCorpus path+    named <- readCorpus path+    return . concat $ map toTrees (sync morph named)   where-    (Tar.NormalFile binary _) = Tar.entryContent entry-    content = L.decodeUtf8 binary+    toTrees (_, xs, ys) = map toForest $ zip+        (concatMap Mx.sentences xs)+        (concatMap sentences ys)+    toForest (x, y) = mkForest (Mx.segments x) (names y) -withBase :: String -> [Tar.Entry] -> [Tar.Entry]-withBase baseName = filter ((==baseName) . takeBaseName . Tar.entryPath)+sync :: [(FilePath, Maybe a)] -> [(FilePath, Maybe b)] -> [(FilePath, a, b)]+sync as bs =+    mapMaybe (uncurry just) (zip as bs)+  where+    just (dir, Just x) (_, Just y) = Just (dir, x, y)+    just _ _ = Nothing
+ Text/NKJP/Tar.hs view
@@ -0,0 +1,40 @@+module Text.NKJP.Tar+( readCorpus+) where++import Control.Applicative ((<$>), (<*>))+import System.FilePath (takeBaseName, takeDirectory)+import Data.List (groupBy, find)+import Data.Function (on)+import qualified Data.Text.Lazy as L+import qualified Data.Text.Lazy.Encoding as L+import qualified Codec.Compression.GZip as GZip+import qualified Codec.Archive.Tar as Tar+import qualified Data.ByteString.Lazy as BS++readTar :: FilePath -> IO [Tar.Entry]+readTar tar+    =  Tar.foldEntries (:) [] (error . show)+    .  Tar.read . GZip.decompress+   <$> BS.readFile tar++withBase :: String -> [Tar.Entry] -> Maybe Tar.Entry+withBase baseName = find ((==baseName) . takeBaseName . Tar.entryPath)++procContent :: (L.Text -> a) -> Tar.Entry -> a+procContent f entry =+    let (Tar.NormalFile binary _) = Tar.entryContent entry+    in  f (L.decodeUtf8 binary)++-- | Visit each .tar directory and return (apart from the directory name)+-- processed contents of the entry with the given name or Nothing if such+-- entry doesn't exists in the directory.+readCorpus :: String -> (L.Text -> a) -> FilePath -> IO [(FilePath, Maybe a)]+readCorpus base f tarPath+    = map onGroup+    . groupBy ((==) `on` (takeDirectory . Tar.entryPath))+   <$> readTar tarPath+  where+    onGroup = (,)+        <$> takeDirectory . Tar.entryPath . head+        <*> (fmap (procContent f) . withBase base)
nkjp.cabal view
@@ -1,5 +1,5 @@ name:               nkjp-version:            0.1.1+version:            0.2.0 synopsis:           Manipulating the National Corpus of Polish (NKJP) description:     The library provides parsing and printing utilities for the@@ -25,16 +25,22 @@       , zlib       , tar >= 0.4 && < 0.5       , filepath-      , data-named+      , data-named >= 0.4 && < 0.5      exposed-modules:-        Data.NKJP.Morphosyntax-      , Data.NKJP.Named-      , Text.NKJP.Morphosyntax+        Text.NKJP.Morphosyntax       , Text.NKJP.Named +    other-modules:+        Text.NKJP.Tar+     ghc-options: -Wall  source-repository head     type: git     location: git://github.com/kawu/nkjp.git++executable named2enamex+  hs-source-dirs: ., tools+  main-is: named2enamex.hs+  ghc-options: -Wall -O2
+ tools/named2enamex.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}++import Control.Monad (forM_, (>=>))+import System.Environment (getArgs)+import Data.Maybe (catMaybes)+import qualified Data.Text as T+import qualified Data.Text.Lazy as L+import qualified Data.Text.Lazy.IO as L++import Data.Named.Tree+import Text.Named.Enamex (showForest)+import qualified Text.NKJP.Named as Ne+import qualified Text.NKJP.Morphosyntax as Mx++neType :: Ne.NE L.Text -> T.Text+neType ne = L.toStrict . L.intercalate "." . catMaybes . map ($ ne) $+    [ Just . Ne.neType+    , Ne.subType+    , Ne.derived >=> return . Ne.derivType ]++orth :: Mx.Seg L.Text -> T.Text+orth = L.toStrict . Mx.orth++main :: IO ()+main = do+    [teiPath] <- getArgs+    fs <- Ne.readTrees teiPath+    forM_ fs $ \ts ->+        L.putStrLn . showForest . mapForest (onEither neType orth) $ ts