module Text.SpellingSuggest.PCDB (
DBConnection, defaultDB,
createDB, openDB, matchDB, closeDB
) where
import qualified Control.Exception as C
import Data.Maybe
import Database.SQLite
import Text.PhoneticCode.Soundex
import Text.PhoneticCode.Phonix
defaultDB :: IO String
defaultDB = return "spelling-suggest.sq3"
createDB :: [String] -> Maybe String -> IO DBConnection
createDB ws dbPath = do
defaultDBPath <- defaultDB
db <- openConnection $ fromMaybe defaultDBPath dbPath
execStatement_ db ("DROP TABLE IF EXISTS " ++ tabName tab ++ ";")
>>= showError
defineTableOpt db True tab >>= showError
execStatement_ db "BEGIN TRANSACTION;" >>= showError
mapM_ (codeRow db) (ws `zip` (map (soundex True) ws `zip`
map phonix ws))
execStatement_ db "COMMIT;" >>= showError
return $ DBConnection db
where
codeRow db (w, (sc, pc)) =
insertRow db (tabName tab) [(colName cw, w),
(colName cs, sc),
(colName cp, pc)] >>= showError
showError :: Maybe String -> IO ()
showError Nothing = return ()
showError (Just s) = fail s
cw = Column { colName = "word",
colType = SQLVarChar 64,
colClauses = [ PrimaryKey False ] }
cs = Column { colName = "soundex",
colType = SQLVarChar 16,
colClauses = [ IsNullable False ] }
cp = Column { colName = "phonix",
colType = SQLVarChar 16,
colClauses = [ IsNullable False ] }
tab = Table { tabName = "phonetic_codes",
tabColumns = [ cw, cs, cp ],
tabConstraints = [] }
newtype DBConnection = DBConnection SQLiteHandle
openDB :: Maybe String -> IO (Maybe DBConnection)
openDB dbPath = do
defaultDBPath <- defaultDB
openDBFile $ fromMaybe defaultDBPath dbPath
where
openDBFile dbp = do
C.catch (do db <- openReadonlyConnection dbp
return (Just (DBConnection db)))
(const (return Nothing) :: C.IOException -> IO (Maybe DBConnection))
matchDB :: DBConnection -> String -> String -> IO [String]
matchDB (DBConnection db) coding code = do
result <- execParamStatement db
("SELECT word FROM phonetic_codes WHERE " ++ coding ++ " = :code ;")
[(":code", Text code)]
case result of
Left msg -> error msg
Right rows -> return (map (snd . head) . head $ rows)
closeDB :: DBConnection -> IO ()
closeDB (DBConnection db) = closeConnection db