Util.hs

module Language.Lojban.Util 
    (-- * Query a Jbovlaste database
     lujvoSelrafsis
    ,lujvosSelrafsi
    ,lujvosSelrafsis
    ,lujvosSelrafsis'
    ,findGismu
    ,findCmavo
    ,findSelrafsi
    ,filterSelma'o
     -- * External programs
    ,grammar
    ,translate
    ,wordType
    ,lujvoAndRate
    ,selma'oInfo
    ,isValidLojban)
    where

import Utils
import Language.Lojban.Jbovlaste
import Control.Arrow
import Data.Char
import Data.List
import Text.Regex

-- | Return the selrafsis of a lujvo (string).
lujvoSelrafsis :: JboDB -> String -> Maybe [JboValsi]
lujvoSelrafsis db = list Nothing (Just . valsiSelrafsis . head) . valsi db

-- | Returns all lujvos which contain the given selrafsi.
lujvosSelrafsi :: JboDB
               -> String     -- ^ selrafsi (either a cmavo or gismu)
               -> [JboValsi] -- ^ lujvos containing said selrafsi
lujvosSelrafsi db w = filterValsi db (any ((==w) . valsiWord) . valsiSelrafsis)

-- | Returns all lujvos which contain any of the given selrafsis.
lujvosSelrafsis :: JboDB
                -> [String]   -- ^ selrafsis
                -> [JboValsi] -- ^ lujvos containing any of the selrafsis
lujvosSelrafsis db ws = filterValsi db (any (flip elem ws . valsiWord) . valsiSelrafsis)

-- | Returns all lujvos which contain all of the given selrafsis (in order).
lujvosSelrafsis' :: JboDB
                -> [String]   -- ^ selrafsis
                -> [JboValsi] -- ^ lujvos containing all of the selrafsis (in order)
lujvosSelrafsis' db ws = filterValsi db ((==ws) . map valsiWord . valsiSelrafsis)

-- | Find a gismu valsi matching the given word.
findGismu :: JboDB -> String -> Maybe JboValsi
findGismu db w = findValsi db gismu where
    gismu v = valsiType v == GismuType && valsiWord v == w

-- | Find a cmavo valsi matching the given word.
findCmavo :: JboDB -> String -> Maybe JboValsi
findCmavo db w = findValsi db cmavo where
    cmavo v = valsiType v == CmavoType && valsiWord v == w

-- | Find a selrafsi matching the given rafsi.
findSelrafsi :: JboDB -> String -> Maybe JboValsi
findSelrafsi db w = findValsi db selrafsi where
    selrafsi v = (valsiType v == CmavoType || valsiType v == GismuType)
              && (any (==w) (valsiRafsis v)
                  ||
                  (length w >= 4 &&
                   valsiType v == GismuType && w `isPrefixOf` valsiWord v))

-- | Returns all cmavo which belong to the given selma'o.
filterSelma'o :: JboDB -> String -> [JboValsi]
filterSelma'o db s = filterValsi db selma'o where
    selma'o v = valsiType v == CmavoType && fmap format (valsiSelma'o v) == Just (format s)
        where format | any isDigit s = lower
                     | otherwise     = filter isLetter . lower

-- | Shows the grammar of a lojban utterance using jbofihe.
grammar :: String                              -- ^ The lojban utterance
        -> IO (Either String (String,String))  -- ^ A pair of error and success strings.
grammar = run "jbofihe -ie"

-- | Translates a lojban utterance to English using jbofihe.
translate :: String                              -- ^ The lojban utterance
          -> IO (Either String (String,String))  -- ^ English output
translate = run "jbofihe -x"

-- | Shows the type of a word using vlatai.
wordType :: String                     -- ^ The lojban word
         -> IO (Either String String)  -- ^ Word type
wordType w = do
  r <- run ("vlatai \"" ++ (lojbanic w) ++ "\"") "" 
  case r of
    Right ("",v) -> return . Right . unwords . words $ v
    Right (e,_)  -> return $ Left e
    Left e       -> return $ Left e

-- | Tries to construct and rate lujvo from selfrasis, using jvocuhadju.
lujvoAndRate :: [String]                           -- ^ selrafsis
             -> IO (Either String [(Int,String)])  -- ^ Word type
lujvoAndRate ws = do
  let selrafsis = unwords $ map (("\""++) . (++"\"") . lojbanic) ws
  r <- run ("jvocuhadju " ++ selrafsis ++ "") ""
  case r of
    Right ("",g) -> return $ Right $ map (rating . trim) $ dropWhile (not . any isDigit) $ lines $ g
    Right (e,_)  -> return $ Left e
    Left e       -> return $ Left e
  where rating = (read *** tail) . break isSpace

-- | Returns information about a selma'o, using mahotic.
selma'oInfo :: String -> IO (Either String String)
selma'oInfo s = do
  r <- run ("mahotci -i \"" ++ upper (lojbanic s) ++ "\"") ""
  case r of
    Right ("",good) -> return $ Right (format good)
    Right (bad,_)   -> return $ Left $ "no entry for \"" ++ s ++ "\""
    Left _          -> return $ Left "mahotci pipe error"
  where format = flip (subRegex r1) "\n" . flip (subRegex r) "\\1 \\2"
        r = mkRegex "([^\n])\n([^\n])"
        r1 = mkRegex "\n\n"

-- | Just checks with jbofihe if some lojban is grammatically valid.
isValidLojban :: String -> IO Bool
isValidLojban line = do
  out <- grammar line
  case out of
    Right (_,"") -> return $ False
    _            -> return $ True

lojbanic = filter good where
    good c = isLetter c || c == '\'' || c == ' '

lower = map toLower
upper = map toUpper