module Language.Lojban.Jbobau
    (newJbobau
    ,jbobauLine
    ,Jbobau)
 where

import Control.Concurrent
import Control.Monad
import Data.Char
import Data.List
import Data.MarkovChain
import Language.Lojban.Util
import System.Directory
import System.IO
import System.IO.Strict (readFile)
import System.Random
import System.Process

-- | Creates a new jbobau handle.
newJbobau :: FilePath -> IO (Either String Jbobau)
newJbobau path = do
  does <- doesFileExist path
  if does
     then connectJbobau path
     else return $ Left "Couldn't find jbobau training data."

connectJbobau :: FilePath -> IO (Either String Jbobau)
connectJbobau path = do
  pipe <- catch (Right `fmap` runInteractiveCommand "java -jar ~/camxes.jar -t")
                (const $ return $ Left "Broken pipe.")
  case pipe of
    Left e -> return $ Left e
    Right (inp,out,err,_) -> do
      hSetBuffering inp LineBuffering
      file <- System.IO.Strict.readFile path
      rg <- newStdGen
      let words' = intercalate ["\n"] $ map words $ lines file

          lines' = lines $ unwords $ run 3 words' 0 rg
      var <- newMVar (Jbobau_ inp out err lines')
      hGetLine out
      return $ Right $ Jbobau var

-- | Returns a random, grammatical, lojbanic sentence.
jbobauLine :: Jbobau -> IO String
jbobauLine (Jbobau jbobau) = do
  jbobau' <- takeMVar jbobau
  (line,lines) <- findM jbobau' (jboLines jbobau')
  putMVar jbobau jbobau' { jboLines = lines }
  return (clean line)
    where
    findM jbobau' (line:lines) = do
      if length (words line) >= 4
         then do line <- validLojban jbobau' line
                 if length (words line) >= 4
                    then do line <- jbofihe line
                            case line of
                              Just line -> return (line,lines)
                              Nothing   -> findM jbobau' lines
                    else findM jbobau' lines
         else findM jbobau' lines

jbofihe :: String -> IO (Maybe String)
jbofihe line = do
  out <- grammar line
  case out of
    Right ("",good) | good /= [] -> return $ Just (extract good)
    _                            -> return $ Nothing
  where extract = map toLower . unwords . words . filter good
        good c = isLetter c || c == '\'' || c == ' '

validLojban :: Jbobau_ -> String -> IO String
validLojban jbobau line = do
  let stdin  = jboIn jbobau
      stdout = jboOut jbobau
  hPutStrLn stdin line
  hGetLine stdout

newtype Jbobau = Jbobau (MVar Jbobau_)

data Jbobau_ = Jbobau_
    { jboIn    :: Handle
    , jboOut   :: Handle
    , jboErr   :: Handle
    , jboLines :: [String]
    }

clean = unwords . words . filter good where
    good c = c /= '.' && c /= '-'