packages feed

polh-lexicon (empty) → 0.1.0

raw patch · 11 files changed

+790/−0 lines, 11 filesdep +basedep +binarydep +containerssetup-changed

Dependencies added: base, binary, containers, directory, filepath, mtl, polysoup, text, text-binary, transformers

Files

+ 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.
+ NLP/Polh/Binary.hs view
@@ -0,0 +1,179 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} ++-- | The module provides functions for working with the binary+-- representation of the historical dictionary of Polish.+-- The dictionary is stored on a disk but we assume that it+-- doesn't change throughtout the program session so that we+-- can provide the pure interface for dictionary reading+-- and searching.++module NLP.Polh.Binary+( savePolh+, loadPolh++, PolhM+, runPolh+, index+, withKey+, lookup+) where++import Prelude hiding (lookup)+import Control.Exception (try, SomeException)+import Control.Monad (when, guard)+import Control.Applicative ((<$>))+import Control.Monad.Reader (ReaderT (..), ask, lift)+import Control.Monad.Trans.Maybe (MaybeT (..))+import System.IO.Unsafe (unsafePerformIO, unsafeInterleaveIO)+import System.FilePath ((</>))+import System.Directory ( getDirectoryContents, createDirectoryIfMissing+                        , createDirectory, doesDirectoryExist )+import Data.Maybe (catMaybes)+import Data.Monoid (mappend, mconcat)+import Data.Binary (encodeFile, decodeFile)+import qualified Data.Map as M+import qualified Data.Set as S+import qualified Data.Text as T++import NLP.Polh.Types+import qualified NLP.Polh.Util as Util++-- | Path to entries in the binary dictionary.+entryDir :: String+entryDir = "entries"++-- | Path to key map in the binary dictionary.+formMapFile :: String+formMapFile = "forms.bin"++-- | A dictionary key (lexical entry ID).+type Key = T.Text++-- | Load the directory contents.+loadContents :: FilePath -> IO [FilePath]+loadContents path = do+    xs <- getDirectoryContents path+    return [x | x <- xs, x /= ".", x /= ".."]++-- | Check if the directory is empty.+emptyDirectory :: FilePath -> IO Bool+emptyDirectory path = null <$> loadContents path++-- | Save the lexical entry on the disk.+saveLexEntry :: FilePath -> LexEntry -> IO ()+saveLexEntry path x = +    let lexPath = T.unpack . lexId+    in  encodeFile (path </> lexPath x) x++-- | Save the polh dictionary in the empty directory.+savePolh :: FilePath -> Polh -> IO ()+savePolh path xs = do+    createDirectoryIfMissing True path+    isEmpty <- emptyDirectory path+    when (not isEmpty) $ do+        error $ "savePolh: directory " ++ path ++ " is not empty"+    let lexPath = path </> entryDir+    createDirectory lexPath+    formMap' <- mconcat <$> mapM (saveLex lexPath) xs+    encodeFile (path </> formMapFile) formMap'+  where+    saveLex lexPath x = do+        saveLexEntry lexPath x+        return $ lexMap x+    lexMap lexEntry = M.fromListWith mappend+        [ (x, S.singleton key)+        | x <- Util.allForms lexEntry ]+      where+        key = lexId lexEntry++maybeErr :: IO a -> IO (Maybe a)+maybeErr io = do+    r <- try io+    case r of+        Left (_e :: SomeException)  -> return Nothing+        Right x                     -> return (Just x)++maybeT :: Monad m => Maybe a -> MaybeT m a+maybeT = MaybeT . return+{-# INLINE maybeT #-}++maybeErrT :: IO a -> MaybeT IO a+maybeErrT io = do+    r <- lift (maybeErr io)+    maybeT r++-- | Load lexical entry from disk by its key.+loadLexEntry :: FilePath -> Key -> IO (Maybe LexEntry)+loadLexEntry path key = do+    maybeErr $ decodeFile (path </> T.unpack key)++-- | Binary dictionary data kept in program memory.+data MemData = MemData+    { polhPath  :: FilePath+    , formMap   :: M.Map T.Text (S.Set Key) }++-- | A PolhM monad is a wrapper over the Polish historical+-- dictionary in a binary form.+newtype PolhM a = PolhM (ReaderT MemData IO a)+    deriving (Functor, Monad)++-- | Path to directory with entries.+entryPath :: MemData -> FilePath+entryPath = (</> entryDir) . polhPath++-- | List of dictionary keys.+index :: PolhM [Key]+index = PolhM $ do+    path <- entryPath <$> ask+    map T.pack <$> lift (loadContents path)++-- | Extract lexical entry with the given ID.+withKey :: Key -> PolhM (Maybe LexEntry)+withKey key = PolhM $ do+    path <- entryPath <$> ask+    lift . unsafeInterleaveIO $ loadLexEntry path key++-- | Lookup the form in the dictionary.+lookup :: T.Text -> PolhM [LexEntry]+lookup x = do+    fm <- PolhM $ formMap <$> ask+    keys <- return $ case M.lookup x fm of+        Nothing -> []+        Just xs -> S.toList xs+    catMaybes <$> mapM withKey keys++-- | Execute the Polh monad against the binary Polh representation+-- located in the given directory.  Return Nothing if the directory+-- doesnt' exist or if it doesn't look like a Polh dictionary.+-- We assume that the binary representation doesn't change so we+-- can provide the pure interface.+runPolh :: FilePath -> PolhM a -> Maybe a+runPolh path (PolhM m) = unsafePerformIO . runMaybeT $ do+    formMap' <- maybeErrT $ decodeFile (path </> formMapFile)+    doesExist <- lift $ doesDirectoryExist (path </> entryDir)+    guard doesExist +    lift $ runReaderT m (MemData path formMap')++-- | Load dictionary from a disk in a lazy manner.  Return 'Nothing'+-- if the path doesn't correspond to a binary representation of the+-- dictionary. +loadPolh :: FilePath -> Maybe Polh+loadPolh path = runPolh path $ do+    keys <- index+    catMaybes <$> mapM withKey keys++-- We don't provide update functionality since we want only the pure+-- iterface to be visible.  It greatly simplifies the implementation.+--+-- updateLexEntry :: FilePath -> Key -> (LexEntry -> LexEntry) -> IO LexEntry+-- updateLexEntry path lexKey f = do+--     lexEntry <- loadLexEntry path lexKey+--     let lexEntry' = f lexEntry+--     saveLexEntry path lexEntry'+--     return lexEntry'+-- +-- updateLexEntry_ :: FilePath -> Key -> (LexEntry -> LexEntry) -> IO ()+-- updateLexEntry_ path lexKey f = do+--     lexEntry <- loadLexEntry path lexKey+--     saveLexEntry path (f lexEntry)
+ NLP/Polh/LMF.hs view
@@ -0,0 +1,9 @@+-- | Re-export modules from the LMF hierarchy.++module NLP.Polh.LMF+( module NLP.Polh.LMF.Parse+, module NLP.Polh.LMF.Show+) where++import NLP.Polh.LMF.Parse+import NLP.Polh.LMF.Show
+ NLP/Polh/LMF/Parse.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE OverloadedStrings #-}++-- | The module provides parsing utilities for the LMF dictionary.++module NLP.Polh.LMF.Parse+( readPolh+, parsePolh+, parseLexEntry+) where++import Control.Monad (join)+import Data.Maybe (mapMaybe, listToMaybe)+import qualified Data.Text as T+import qualified Data.Text.Lazy as L+import qualified Data.Text.Lazy.IO as L+import qualified Text.XML.PolySoup as Soup+import Text.XML.PolySoup hiding (XmlParser, Parser, join)++import NLP.Polh.Types++import Debug.Trace (trace)++type Parser a = Soup.XmlParser L.Text a++lmfP :: Parser [LexEntry]+lmfP = true //> lexEntryP++lexEntryP :: Parser LexEntry+lexEntryP = tag "LexicalEntry" *> getAttr "id" >^>+  \lexId' -> collTags >>=+  \tags   -> return $+    let with p = tagsParseXml (findAll p) tags+    in  LexEntry+        { lexId         = L.toStrict lexId'+        , lineRef       = listToMaybe $ with lineRefP+        , status        = listToMaybe $ with statusP+        , pos           = with posP+        , lemma         = first "lemmaP" (with lemmaP)+        , forms         = with formP+        , components    = join (with compoP)+        , syntactic     = with synP+        , senses        = with senseP+        , related       = with relP }+    +first :: Show a => String -> [a] -> a+first _   [x] = x+first src []  = error $ src ++ ": null xs"+first src xs  = error $ src ++ ": xs == " ++ show xs++posP :: Parser T.Text+posP = featP "partOfSpeech"++lineRefP :: Parser T.Text+lineRefP = featP "lineRef"++statusP :: Parser T.Text+statusP = featP "status"++lemmaP :: Parser Lemma+lemmaP = Lemma <$> (tag "Lemma" /> reprP)++formP :: Parser WordForm+formP = WordForm <$> (tag "WordForm" /> reprP)++compoP :: Parser [T.Text]+compoP = map L.toStrict <$> (tag "ListOfComponents" /> cut (getAttr "entry"))++relP :: Parser RelForm+relP = tag "RelatedForm" *> getAttr "targets" >^> \relTo' -> do+    rs <- many reprP+    return $ RelForm+        { relRepr = rs+        , relTo   = L.toStrict relTo' }++otherP :: Parser ()+otherP = tagOpenName >^> \name ->+    warning ("tag " ++ L.unpack name ++ " ignored") ignore++warning :: String -> Parser a -> Parser a+warning msg x = trace ("WARNING: " ++ msg) x++grave :: String -> Parser a -> Parser a+grave msg x = trace ("ERROR: " ++ msg) x++grave' :: String -> a -> Parser a+grave' msg x = grave msg (return x)++synP :: Parser SynBehaviour+synP = tag "SyntacticBehaviour" *> getAttr "senses" >^> \senses' -> do+    repr' <- reprBodyP+    let senseIds = T.words (L.toStrict senses')+    return (SynBehaviour [repr'] senseIds)++data SenseContent+    = SenseDef Definition+    | SenseStyle T.Text+    | SenseCxt Context+    | SenseOther ()++senseStyle :: SenseContent -> Maybe T.Text+senseStyle (SenseStyle x) = Just x+senseStyle _              = Nothing++senseDef :: SenseContent -> Maybe Definition+senseDef (SenseDef def) = Just def+senseDef _              = Nothing++senseCxt :: SenseContent -> Maybe Context+senseCxt (SenseCxt cxt) = Just cxt+senseCxt _              = Nothing++senseP :: Parser Sense+senseP = tag "Sense" *> maybeAttr "id" >^> \senseId' -> do+    xs <- many $ oneOf+        [ SenseDef      <$> defP+        , SenseStyle    <$> styleP+        , SenseCxt      <$> cxtP+        , SenseOther    <$> otherP ]+    let styl' = mapMaybe senseStyle xs+    let defs' = mapMaybe senseDef xs+    let cxts' = mapMaybe senseCxt xs+    return $ Sense+        { senseId = L.toStrict <$> senseId'+        , style = styl'+        , defs  = defs'+        , cxts  = cxts' }++defP :: Parser Definition+defP = Definition <$> (tag "Definition" /> reprP)++cxtP :: Parser Context+cxtP = Context <$> (tag "Context" /> reprP)++styleP :: Parser T.Text+styleP = featP "style"++reprP :: Parser Repr+reprP = tag "FormRepresentation" <|> tag "TextRepresentation" ^> reprBodyP++reprBodyP :: Parser Repr+reprBodyP = Repr+    <$> featP "writtenForm"+    <*> (featP "language" <|> grave' "language not specified" "polh")+    <*> (optional $ featP "sourceID")++featP :: L.Text -> Parser T.Text+featP att = L.toStrict <$>+    cut (tag "feat" *> hasAttr "att" att *> getAttr "val")++-- | Read the dictionary from the LMF file.+readPolh :: FilePath -> IO Polh+readPolh = fmap parsePolh . L.readFile++-- | Parse the entire dictionary in the LMF format.+parsePolh :: L.Text -> Polh+parsePolh = parseXml lmfP++-- | Parse the lexical entry LMF representation+parseLexEntry :: L.Text -> LexEntry+parseLexEntry = parseXml lexEntryP
+ NLP/Polh/LMF/Show.hs view
@@ -0,0 +1,170 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Printing utilities for the LMF dictionary format.++module NLP.Polh.LMF.Show+( showPolh+, showLexEntry+) where++import Data.Monoid (Monoid, mappend, mconcat)+import Data.List (intersperse)+import Data.Maybe (maybeToList)+import qualified Data.Text as T+import qualified Data.Text.Lazy as L+import qualified Data.Text.Lazy.Builder as L+import Text.XML.PolySoup (escapeXml)++import NLP.Polh.Types++-- | An infix synonym for 'mappend'.+{-# INLINE (<>) #-}+(<>) :: Monoid m => m -> m -> m+(<>) = mappend++-- | Indentation parameter.+indentSize :: Int+indentSize = 2++identPref :: L.Builder+identPref = L.fromLazyText (L.replicate (fromIntegral indentSize) " ")++{-# INLINE ident #-}+ident :: L.Builder -> L.Builder+ident = (identPref <>)++prolog :: [L.Builder]+prolog =+    [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"+    , "<LexicalResource dtdVersion=\"16\">"+    , "  <GlobalInformation>"+    , "    <feat att=\"languageCoding\" val=\"ISO 639-6\"/>"+    , "  </GlobalInformation>"+    , "  <Lexicon>" ]++epilog :: [L.Builder]+epilog =+    [ "  </Lexicon>"+    , "</LexicalResource>" ]++-- | Show the entire dictionary as a lazy text in the LMF format.+showPolh :: Polh -> L.Text+showPolh =+    L.toLazyText . mconcat . map (<> "\n") . embed . concatMap buildLexEntry+    where embed body = prolog ++ map (ident.ident) body ++ epilog++-- | Show lexical entry using the LMF format.+showLexEntry :: LexEntry -> L.Text+showLexEntry =+    L.toLazyText . mconcat . map (<> "\n") . buildLexEntry++buildElem :: L.Builder -> [L.Builder] -> L.Builder -> [L.Builder]+buildElem beg body end = beg : map ident body ++ [end] ++-- | Each output line is represented as a builder. We use separate builders+-- for separate lines because we want to easilly indent the output text.+buildLexEntry :: LexEntry -> [L.Builder]+buildLexEntry lx =+    buildElem beg body end+  where+    beg = "<LexicalEntry id=\"" <> L.fromText (lexId lx) <> "\">"+    end = "</LexicalEntry>"+    body+        =  map (buildFeat "lineRef") (maybeToList $ lineRef lx)+        ++ map (buildFeat "status") (maybeToList $ status lx)+        ++ map (buildFeat "partOfSpeech") (pos lx)+        ++ buildLemma (lemma lx)+        ++ concatMap buildForm (forms lx)+        ++ concatMap buildRelForm (related lx)+        ++ buildComps (components lx)+        ++ concatMap buildSyn (syntactic lx)+        ++ concatMap buildSense (senses lx)++buildLemma :: Lemma -> [L.Builder]+buildLemma base =+    buildElem beg body end+  where+    beg = "<Lemma>"+    end = "</Lemma>"+    body = concatMap (buildRepr "FormRepresentation") (repr base)++buildForm :: WordForm -> [L.Builder]+buildForm form =+    buildElem beg body end+  where+    beg = "<WordForm>"+    end = "</WordForm>"+    body = concatMap (buildRepr "FormRepresentation") (repr form)++buildRelForm :: RelForm -> [L.Builder]+buildRelForm form =+    buildElem beg body end+  where+    beg = "<RelatedForm targets=\"" <> L.fromText (relTo form) <> "\">"+    end = "</RelatedForm>"+    body = concatMap (buildRepr "FormRepresentation") (repr form)++buildComps :: [T.Text] -> [L.Builder]+buildComps [] = []+buildComps xs =+    buildElem beg body end+  where+    beg = "<ListOfComponents>"+    end = "</ListOfComponents>"+    body = map comp xs+    comp x = "<Component entry=\"" <> L.fromText x <> "\"/>"++buildSyn :: SynBehaviour -> [L.Builder]+buildSyn syn =+    buildElem beg body end+  where+    ids = mconcat . intersperse " " . map L.fromText $ synSenseIds syn+    beg = "<SyntacticBehaviour senses=\"" <> ids <> "\">"+    end = "</SyntacticBehaviour>"+    body = concatMap (buildRepr "TextRepresentation") (repr syn)++buildSense :: Sense -> [L.Builder]+buildSense sense =+    buildElem beg body end+  where+    beg = case senseId sense of+        Just x  -> "<Sense id=\"" <> L.fromText x <> "\">"+        Nothing -> "<Sense>"+    end = "</Sense>"+    body+        =  map (buildFeat "style") (style sense)+        ++ concatMap buildDef (defs sense)+        ++ concatMap buildCxt (cxts sense)++buildDef :: Definition -> [L.Builder]+buildDef def =+    buildElem beg body end+  where+    beg = "<Definition>"+    end = "</Definition>"+    body = concatMap (buildRepr "TextRepresentation") (repr def)++buildCxt :: Context -> [L.Builder]+buildCxt cxt =+    buildElem beg body end+  where+    beg = "<Context>"+    end = "</Context>"+    body = concatMap (buildRepr "TextRepresentation") (repr cxt)++buildRepr :: L.Builder -> Repr -> [L.Builder]+buildRepr tag rp =+    buildElem beg body end+  where+    beg = "<"  <> tag <> ">"+    end = "</" <> tag <> ">"+    body =+        [ buildFeat "writtenForm" . escapeXml $ writtenForm rp+        , buildFeat "language" (language rp) ] ++ source+    source = case sourceID rp of+        Just x  -> [buildFeat "sourceID" x]+        Nothing -> []++buildFeat :: L.Builder -> T.Text -> L.Builder+buildFeat att val =+    "<feat att=\"" <> att <> "\" val=\"" <> L.fromText val <> "\"/>"
+ NLP/Polh/Types.hs view
@@ -0,0 +1,157 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}++-- | The module provides types for dictionary representation.++module NLP.Polh.Types+( Repr (..)+, HasRepr (..)+, text+, WordForm (..)+, Lemma (..)+, RelForm (..)+, Definition (..)+, Context (..)+, SynBehaviour (..)+, Sense (..)+, LexEntry (..)+, Polh+) where++import Control.Applicative ((<$>), (<*>))+import qualified Data.Text as T+import Data.Text.Binary ()+import Data.Binary (Binary, put, get)++-- | Form or text representation.+data Repr = Repr+    { writtenForm :: T.Text+    , language    :: T.Text+    , sourceID    :: Maybe T.Text }+    deriving (Show, Read, Eq, Ord)++instance Binary Repr where+    put Repr{..} = do+        put writtenForm+        put language+        put sourceID+    get = Repr <$> get <*> get <*> get++-- | A class of objects with a written representation.+class HasRepr t where+    repr :: t -> [Repr]++instance HasRepr [Repr] where+    repr = id++-- | Get textual representations of an object.+text :: HasRepr t => t -> [T.Text]+text = map writtenForm . repr+{-# INLINE text #-}++-- | A word form.+newtype WordForm = WordForm [Repr]+    deriving (Show, Read, Eq, Ord, Binary, HasRepr)++-- | A related form.+data RelForm = RelForm+    { relRepr   :: [Repr]+    , relTo     :: T.Text }+    deriving (Show, Read, Eq, Ord)++instance Binary RelForm where+    put RelForm{..} = do+        put relRepr+        put relTo+    get = RelForm <$> get <*> get++instance HasRepr RelForm where+    repr = relRepr++-- | A lemma (base) form.+newtype Lemma = Lemma [Repr]+    deriving (Show, Read, Eq, Ord, Binary, HasRepr)++-- | A definition of the lexeme sense.+newtype Definition = Definition [Repr]+    deriving (Show, Read, Eq, Ord, Binary, HasRepr)++-- | A context in which a given sense is illustrated.+newtype Context = Context [Repr]+    deriving (Show, Read, Eq, Ord, Binary, HasRepr)++-- | A description of a syntactic behaviour.+data SynBehaviour = SynBehaviour+    { synRepr     :: [Repr]+    , synSenseIds :: [T.Text] }+    deriving (Show, Read, Eq, Ord)++instance HasRepr SynBehaviour where+    repr = synRepr++instance Binary SynBehaviour where+    put SynBehaviour{..} = do+        put synRepr+        put synSenseIds+    get = SynBehaviour <$> get <*> get++-- | A potential sense of a given lexeme.+data Sense = Sense+    { senseId   :: Maybe T.Text+    , style     :: [T.Text]+    , defs      :: [Definition]+    , cxts      :: [Context] }+    deriving (Show, Read, Eq, Ord)++instance Binary Sense where+    put Sense{..} = do+        put senseId+        put style+        put defs+        put cxts+    get = Sense <$> get <*> get <*> get <*> get++-- | A description of a lexeme.+data LexEntry = LexEntry {+    -- | An ID of the lexical entry.+      lexId         :: T.Text+    -- | A line reference number.  Provisional field.+    , lineRef       :: Maybe T.Text+    -- | A status of the lexeme.  Provisional field.+    , status        :: Maybe T.Text+    -- | Potential parts of speech.+    , pos           :: [T.Text]+    -- | A base form.+    , lemma         :: Lemma+    -- | Word forms of the lexeme.+    , forms         :: [WordForm]+    -- | A list of components (only when the entry represent+    -- a compound lexeme).+    , components    :: [T.Text]+    -- | A list of potential syntactic behaviours of the lexeme.+    , syntactic     :: [SynBehaviour]+    -- | A list of potential semantic descriptions.+    , senses        :: [Sense]+    -- | Forma related to the lexeme.+    , related       :: [RelForm] }+    deriving (Show, Read, Eq, Ord)++instance Binary LexEntry where+    put LexEntry{..} = do+        put lexId+        put lineRef+        put status+        put pos+        put lemma+        put forms+        put components+        put syntactic+        put senses+        put related+    get = LexEntry <$> get <*> get <*> get <*> get <*> get+                   <*> get <*> get <*> get <*> get <*> get++-- | A polh dictionary is a list of lexical entries.+type Polh = [LexEntry]
+ NLP/Polh/Util.hs view
@@ -0,0 +1,24 @@+-- | Some utility functions for working with the dictionary.++module NLP.Polh.Util+( allForms+, hasForm+, addForm+) where++import qualified Data.Text as T+import NLP.Polh.Types++-- | All format (base form + other forms) of the lexeme.+allForms :: LexEntry -> [T.Text]+allForms lx+    =  text (lemma lx) +    ++ concatMap text (forms lx)++-- | Does lexeme take the given form? +hasForm :: LexEntry -> T.Text -> Bool+hasForm lx x = x `elem` allForms lx++-- | Add new word form to the lexeme description.+addForm :: WordForm -> LexEntry -> LexEntry+addForm x lx = lx { forms = (x : forms lx) }
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ polh-lexicon.cabal view
@@ -0,0 +1,43 @@+name:               polh-lexicon+version:            0.1.0+synopsis:           Interface to a historical dictionary of Polish +description:+    Interface to a historical dictionary of Polish.+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/synat+build-type:         Simple++library+  exposed-modules:    NLP.Polh.Types+                      NLP.Polh.LMF+                      NLP.Polh.LMF.Parse+                      NLP.Polh.LMF.Show+                      NLP.Polh.Binary+                      NLP.Polh.Util+  build-depends:      base >= 4 && < 5 +                    , containers+                    , directory+                    , filepath+                    , text+                    , binary+                    , text-binary >= 0.1 && < 0.2+                    , polysoup >= 0.1 && < 0.2+                    , transformers+                    , mtl++  ghc-options: -Wall++executable polh-binarize+  hs-source-dirs: ., tools+  main-is: polh-binarize.hs++executable polh-show+  hs-source-dirs: ., tools+  main-is: polh-show.hs
+ tools/polh-binarize.hs view
@@ -0,0 +1,7 @@+import System.Environment (getArgs)+import NLP.Polh.LMF (readPolh)+import NLP.Polh.Binary (savePolh)++main = do+    [lmfPath, binPath] <- getArgs+    savePolh binPath =<< readPolh lmfPath
+ tools/polh-show.hs view
@@ -0,0 +1,11 @@+import System.Environment (getArgs)+import qualified Data.Text.Lazy.IO as L++import NLP.Polh.LMF (showPolh)+import NLP.Polh.Binary (loadPolh)++main = do+    [binPath] <- getArgs+    case loadPolh binPath of+        Nothing -> error "Not a dictionary"+        Just ph ->  L.putStr (showPolh ph)