diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/NLP/Polh/Binary.hs b/NLP/Polh/Binary.hs new file mode 100644 --- /dev/null +++ b/NLP/Polh/Binary.hs @@ -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) diff --git a/NLP/Polh/LMF.hs b/NLP/Polh/LMF.hs new file mode 100644 --- /dev/null +++ b/NLP/Polh/LMF.hs @@ -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 diff --git a/NLP/Polh/LMF/Parse.hs b/NLP/Polh/LMF/Parse.hs new file mode 100644 --- /dev/null +++ b/NLP/Polh/LMF/Parse.hs @@ -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 diff --git a/NLP/Polh/LMF/Show.hs b/NLP/Polh/LMF/Show.hs new file mode 100644 --- /dev/null +++ b/NLP/Polh/LMF/Show.hs @@ -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 = + [ "" + , "" + , " " + , " " + , " " + , " " ] + +epilog :: [L.Builder] +epilog = + [ " " + , "" ] + +-- | 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 = " L.fromText (lexId lx) <> "\">" + end = "" + 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 = "" + end = "" + body = concatMap (buildRepr "FormRepresentation") (repr base) + +buildForm :: WordForm -> [L.Builder] +buildForm form = + buildElem beg body end + where + beg = "" + end = "" + body = concatMap (buildRepr "FormRepresentation") (repr form) + +buildRelForm :: RelForm -> [L.Builder] +buildRelForm form = + buildElem beg body end + where + beg = " L.fromText (relTo form) <> "\">" + end = "" + body = concatMap (buildRepr "FormRepresentation") (repr form) + +buildComps :: [T.Text] -> [L.Builder] +buildComps [] = [] +buildComps xs = + buildElem beg body end + where + beg = "" + end = "" + body = map comp xs + comp x = " L.fromText x <> "\"/>" + +buildSyn :: SynBehaviour -> [L.Builder] +buildSyn syn = + buildElem beg body end + where + ids = mconcat . intersperse " " . map L.fromText $ synSenseIds syn + beg = " ids <> "\">" + end = "" + body = concatMap (buildRepr "TextRepresentation") (repr syn) + +buildSense :: Sense -> [L.Builder] +buildSense sense = + buildElem beg body end + where + beg = case senseId sense of + Just x -> " L.fromText x <> "\">" + Nothing -> "" + end = "" + 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 = "" + end = "" + body = concatMap (buildRepr "TextRepresentation") (repr def) + +buildCxt :: Context -> [L.Builder] +buildCxt cxt = + buildElem beg body end + where + beg = "" + end = "" + 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 = + " att <> "\" val=\"" <> L.fromText val <> "\"/>" diff --git a/NLP/Polh/Types.hs b/NLP/Polh/Types.hs new file mode 100644 --- /dev/null +++ b/NLP/Polh/Types.hs @@ -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] diff --git a/NLP/Polh/Util.hs b/NLP/Polh/Util.hs new file mode 100644 --- /dev/null +++ b/NLP/Polh/Util.hs @@ -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) } diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,4 @@ +#! /usr/bin/env runhaskell + +> import Distribution.Simple +> main = defaultMain diff --git a/polh-lexicon.cabal b/polh-lexicon.cabal new file mode 100644 --- /dev/null +++ b/polh-lexicon.cabal @@ -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 diff --git a/tools/polh-binarize.hs b/tools/polh-binarize.hs new file mode 100644 --- /dev/null +++ b/tools/polh-binarize.hs @@ -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 diff --git a/tools/polh-show.hs b/tools/polh-show.hs new file mode 100644 --- /dev/null +++ b/tools/polh-show.hs @@ -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)