bitspeak-0.0.1: src/Main.hs

import Data.IORef
import Data.List
import Data.Char
import Control.Monad
import Gui (doGui)
import Corpora (englishCorpus,portugueseCorpus)

alphabet = "abcdefghijklmnopqrstuvwxyz+-,."

{-

    'splitData' is the selection engine. Given a corpus with
    Integer word frequencies a character string is splited
    at a point where a balance of frequency between parts is
    attempted. 'n' parameter is a balance measure.

-}

splitData :: [(String,Integer)] -> Integer -> String -> (String,String)
splitData _ _ [] = ([],[])
splitData sufixes n chars@(ch:ct)
    | n < 0 = reversePair $ splitData sufixes (negate n) (reverse chars)
    | otherwise = (ch:s1,s2)
        where
            reversePair (a,b) = (reverse b,reverse a)
            sh :: [(String,Integer)]
            (sh,st) = (flip partition) sufixes $ (== ch) . head . fst
            np = foldl (+) 1 $ map snd sh
            (s1,s2) = splitData st (n - np) ct

main = do

    -- Following IORefs are all the application state.

    currentWord <- newIORef ""
    fullText <- newIORef [] :: IO (IORef [String])
    choices <- newIORef undefined :: IO (IORef (String,String))
    sufixes <- newIORef undefined :: IO (IORef [(String,Integer)])
    corpus <- newIORef [] :: IO (IORef [(String,Integer)])

    resetSufixes <- return $ readIORef currentWord >>= \w -> readIORef corpus >>=
        \e -> writeIORef sufixes $ filter (not . null . fst) $
        map (uncurry $ (,). (drop (length w))) $ filter (isPrefixOf w . fst) e

    resetChoices <- return $ readIORef sufixes >>= \s ->
        writeIORef choices $ splitData s 0 alphabet

    addToWord <- return $ \c -> modifyIORef currentWord (++ [c])

    enterWord <- return $ readIORef currentWord >>= \w -> when (not $ null w) $
        modifyIORef fullText (++ [w]) >> writeIORef currentWord ""

    undoWord <- return $ do
        w <- readIORef currentWord
        when (null w) $ modifyIORef fullText $ reverse . drop 1 . reverse
        writeIORef currentWord ""

    -- After initialization, doGui is called, provided with
    -- IO functions allowing user actions to be mapped to
    -- actions defined above.

    resetSufixes >> resetChoices

    doGui (readIORef choices) (readIORef currentWord)
        (liftM unwords $ readIORef fullText)
        (writeIORef corpus) $ \leftOrRight -> do
            let side = either (const fst) (const snd) leftOrRight
            sf <- readIORef sufixes
            modifyIORef choices $ splitData sf 0 . side
            readIORef choices >>= \ch -> case ch of
                (c:[],[]) -> do
                    unless (c == '+' || c == '-') $
                        addToWord c
                    when (c == '.') $
                        addToWord '\n'
                    when (c == '+' || c == ',' || c == '.') $
                        enterWord
                    when (c == '-') $
                        undoWord 
                    resetSufixes >> resetChoices
                _ -> return ()