lojban (empty) → 0.0

raw patch · 5 files changed

+272/−0 lines, 5 filesdep +basedep +parsecdep +strictsetup-changed

Dependencies added: base, parsec, strict, xml

Files

• LICENSE +25/−0
• Lojban/Jbovlaste.hs +151/−0
• Lojban/Lujvo.hs +76/−0
• Setup.lhs +3/−0
• lojban.cabal +17/−0

@@ -0,0 +1,25 @@+* Copyright (c) <year>, <copyright holder>+* 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.+*     * Neither the name of the <organization> nor the+*       names of its contributors may be used to endorse or promote products+*       derived from this software without specific prior written permission.+*+* THIS SOFTWARE IS PROVIDED BY <copyright holder> ''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 <copyright holder> 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.+

@@ -0,0 +1,151 @@+-- | A module which provides an way to query XML exports of Jbovlaste.++{-# LANGUAGE PatternGuards #-}++module Lojban.Jbovlaste +    (-- * Types+     JbovlasteDB+    ,JbovlasteEntry+    ,JbovlasteEntryType(..)+    -- * Opening+    ,openJbovlaste+    -- * Querying+    ,valsi+    ,selma'o+    ,selrafsi+    ,selrafsis+    ,findByDef+    ,filterEntries+    -- * Inspection+    ,entryWord+    ,entryType+    ,entryGloss)+    where++import Prelude hiding (readFile,elem)+import System.IO.Strict (readFile)+import Text.XML.Light.Input+import Text.XML.Light.Types+import Text.XML.Light.Proc+import Control.Applicative+import Data.Maybe+import Data.List hiding (elem)+import Data.Char+import Data.Function+import Lojban.Lujvo++-- | Open an XML export of Jbovlaste for querying (strictly).+openJbovlaste :: FilePath -> IO (Maybe JbovlasteDB)+openJbovlaste path = (JDB path <$>) <$> parseXMLDoc <$> readFile path++-- | Find the selrafsis of a lujvo.+selrafsis :: JbovlasteDB -> String -> [String]+selrafsis db = map fromJust . catMaybes . map ((entryWord <$>) . selrafsi db . show) . rafsis++-- | Filter entries according to a predicate.+filterEntries :: JbovlasteDB -> (JbovlasteEntry -> Bool) -> [JbovlasteEntry]+filterEntries db f = (entry db <$>) . filterElements (f . entry db) $ elem db++-- | Find (maybe) a valsi by rafsi.+selrafsi :: JbovlasteDB -> String -> Maybe JbovlasteEntry+selrafsi db t = entry db <$> filterElement match (elem db) where+    match e | any ((==t) . strContent) $ findChildren (name "rafsi") e = True+            | length t' >= 4 && isPrefixOf t (fromMaybe "" $ attr "word" e) +              && (attr "type" e == Just "gismu" || attr "type" e == Just "cmavo") = True+            | otherwise = False+    t' = filter (/='\'') t++-- | Find valsi(s) by selma'o.+selma'o :: JbovlasteDB -> String -> [JbovlasteEntry]+selma'o db t = entry db <$> filterElements match (elem db) where+    match = any ((==lower t) . lower . strContent) . findChildren (name "selmaho")++-- | Find a valsi by searching for word or gloss, and+--   resolving gloss entries to valsi entries.+valsi :: JbovlasteDB -> String -> [JbovlasteEntry]+valsi db t = entry db <$> (resolve db $ filterElements match (elem db)) where+    match e | Just w <- attr "word" e = w == t+            | otherwise               = False++-- | Find valsis according to a predicate applied to the definition.+findByDef :: JbovlasteDB -> (String -> Bool) -> [JbovlasteEntry]+findByDef db t = entry db <$> filterElements match (elem db) where+    match = any (t . strContent) . findChildren (name "definition")++-- | Inspect an entry for the word.+entryWord :: JbovlasteEntry -> Maybe String+entryWord = attr "word" . entryElem++-- | Inspect an entry for the gloss.+entryGloss :: JbovlasteEntry -> Maybe String+entryGloss = _entryGloss++-- | What type of word is the entry?+entryType :: JbovlasteEntry -> JbovlasteEntryType+entryType e = case attr "type" $ entryElem e of+                Just "cmavo" -> Cmavo+                Just "lujvo" -> Lujvo+                Just "gismu" -> Gismu+                _ -> Other++-- Construct an entry.+entry db e = Entry e (gloss db e)++-- Find the gloss for a valsi.+gloss :: JbovlasteDB -> Element -> Maybe String+gloss db e = attr "word" =<< filterElement filter (elem db) where+    filter e' | elName e' == name "nlword"+              , attr "place" e' == Just "1" || attr "place" e' == Nothing+              , attr "valsi" e' == attr "word" e = True+              | otherwise                        = False++-- Resolve gloss words to their lojban valsi entries.+resolve :: JbovlasteDB -> [Element] -> [Element]+resolve db = map resolve where+    resolve e | elName e == name "nlword"+              , Just v <- attr "valsi" e = fromMaybe e $ findValsi db v+              | otherwise                = e++-- Find a valsi.+findValsi :: JbovlasteDB -> String -> Maybe Element+findValsi db w = filterElement match $ elem $ db where+    match e | elName e == name "valsi"+            , Just w' <- attr "word" e = w' == w+            | otherwise                = False++instance Show JbovlasteDB where+    show (JDB path _) = "JbovlasteDB: " ++ path++-- | Opaque data type to be operated on.+data JbovlasteDB = JDB { path :: FilePath, elem :: Element }++instance Show JbovlasteEntry where+    show (Entry e g) = thetype ++ word ++ selmaho ++ rafsi ++ gloss ++ def ++ notes where+      thetype = fromMaybe "" $ attr "type" e+      word = maybe "" (\w -> " {" ++ w ++ "}") $ attr "word" e+      selmaho = maybe "" selmaho' (strContent <$> findChild (name "selmaho") e)+      selmaho' e = ", of selma'o {" ++ e ++ "}"+      rafsi = rafsi' $ commas $ map strContent $ findChildren (name "rafsi") e+      rafsi' "" = ""+      rafsi' rs = " with rafsi {" ++ rs ++ "}"+      def = maybe "" (": "++) $ strContent <$> findChild (name "definition") e+      notes = maybe "" notes' $ strContent <$> findChild (name "notes") e+      notes' n = " (" ++ n ++ ")"+      gloss = maybe "" ((", glossing to {"++) . (++"}")) g++instance Eq JbovlasteEntry where+    x == y = ((==) `on` entryType) x y && ((==) `on` entryWord) x y++-- | Opaque data type for entries.+data JbovlasteEntry = Entry { entryElem :: Element, _entryGloss :: Maybe String }+data JbovlasteEntryType = Gismu | Cmavo | Lujvo | Other deriving (Eq,Show,Ord)++-- Utilities+-- Make a simple name.+name n = QName n Nothing Nothing+-- Find an attribute of a specific name.+attr = findAttr . name+-- Just separate a list by commas.+commas = concat . intersperse ", "+--+lower = map toLower

@@ -0,0 +1,76 @@+module Lojban.Lujvo (rafsis,Rafsi(..)) where++import Prelude hiding ((^),(*),(/),(+))+import Text.ParserCombinators.Parsec hiding (notFollowedBy)+import Control.Monad+import Control.Applicative ((<$>))++data Rafsi = ShortRafsi [Char] | Rafsi4Let [Char] | Rafsi5Let [Char]+instance Show Rafsi where+    show (ShortRafsi e) = e+    show (Rafsi4Let e) = e+    show (Rafsi5Let e) = e++rafsis :: String -> [Rafsi]+rafsis s = +    case parse lujvo "" s of+      Right rs -> rs+      Left _ -> []++lujvo = ((rafsi5 <!anyChar / rafsi3 / rafsi4)+) <!anyChar+rafsi3 = ShortRafsi <$> ((cvc / ccv / cvv) <!y <!(anyChar >> y))+rafsi4 = Rafsi4Let <$> (ct & (vt & ct / ct & vt) & ct <&anyChar <&!(y?))+rafsi5 = do (Rafsi4Let ls) <- rafsi4; v <- vowel; return $ Rafsi5Let (ls++v)+cvc = ct & vt & ct <&anyChar <&!(y?)+ccv = ct & ct & vt <&!(((r / n) <& consonant)?)+cvv = ct & (diphthong / vt & h & vt) <&!(((r / n) <& consonant)?)+ct = consonant+vt = vowel+syllabic = l / m / n / r+consonant = voiced / unvoiced / syllabic+diphthong = (a & i / a & u / e & i / o & i) <!nucleus <!glide+vowel = (a / e / i / o / u) <!nucleus+a = oneOf' "aA"+e = oneOf' "eE"+i = oneOf' "iI"+o = oneOf' "oO"+u = oneOf' "uU"+y = oneOf' "yY"+affricate = t & c / t & s / d & j / d & z+glide = (i / u) <&nucleus <!glide+nucleus = vowel / diphthong / y <!nucleus+voiced = b / d / g / j / v / z+unvoiced = c / f / k / p / s / t / x+l = oneOf' "lL" <!l+m = oneOf' "mM" <!m <!z+n = oneOf' "nN" <!n <!affricate+r = oneOf' "rR" <!r+b = oneOf' "bB" <!b <!unvoiced+d = oneOf' "dD" <!d <!unvoiced+g = oneOf' "gG" <!g <!unvoiced+v = oneOf' "vV" <!v <!unvoiced+j = oneOf' "jJ" <!j <!z <!unvoiced+z = oneOf' "zZ" <!z <!j <!unvoiced+s = oneOf' "sS" <!s <!c <!voiced+c = oneOf' "cC" <!c <!s <!x <!voiced+x = oneOf' "xX" <!x <!c <!k <!voiced+k = oneOf' "kK" <!k <!x <!voiced+f = oneOf' "fF" <!f <!voiced+p = oneOf' "pP" <!p <!voiced+t = oneOf' "tT" <!t <!voiced+h = oneOf' "'h" <!h <&nucleus++p <&! p1 = do r <- p; p1; return r+infixl 2 <&!+oneOf' p = oneOf p >>= return . (:[])+(+) p = many1 (try p)+(*) p = many (try p)+(<!) a a1 = do r <- a; ((try a1 >>= unexpected . show) <|> return r)+infixl 2 <!+(/) a a1 = (try a <|> a1)+infixl 1 /+(&) a a1 = (do r <- a; r1 <- a1; return $ mplus r r1)+infixl 4 &+(<&) a a1 = do r <- a; lookAhead a1; return r+infixl 2 <&+(?) p = (try p <|> return mzero)

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,17 @@+name:                lojban+version:             0.0+synopsis:            <Project description>+description:         <Project description>+category:            Language+license:             BSD3+license-file:        LICENSE+author:              Chris Done <chrisdone@gmail.com>+maintainer:          chrisdone@gmail.com+build-Depends:       base+cabal-Version:       >= 1.2+build-type:          Simple++library+  build-depends: base,xml,strict,parsec+  exposed-modules: Lojban.Jbovlaste,Lojban.Lujvo+  ghc-options: -O2