condor-0.3: src-app/Main.hs

module Main where

import System.Environment
import System.Directory (removeFile, renameFile)
import Control.Exception
import Control.Monad
import Data.Binary
import qualified Data.Text as T
import Condor.Search.Index
import qualified Condor.Reader.Text as TextReader
import IO


-- | Commands dispatcher
dispatch :: [(String, [String] -> Index -> IO ())]  
dispatch =  [ ("index", indexCmd)  
            , ("search", searchCmd)  
            ]
indexFile :: FilePath            
indexFile = "index.db"

-- This is dummy main function (not working yet)
main :: IO ()
main = do
    idx <- (readIndex indexFile) `catch` readIndexError
    (command:args) <- getArgs
    let (Just action) = lookup command dispatch
    action args idx


-- | Read Index data from file
readIndex :: FilePath -> IO Index
readIndex p = {-# SCC "read" #-} decodeFile p

-- | Create empty index if can't read from file
readIndexError :: IOError -> IO Index
readIndexError _ = return emptyIndex

-- | Silent IO error
nullError :: IOError -> IO ()
nullError _ = return ()

-- | Write index data to the file
writeIndex :: FilePath -> Index -> IO ()
writeIndex p idx = do
    putStrLn $ "Entries count: " ++ show (termCount idx)
    let temp = p ++ ".temp" 
    encodeFile temp idx
    removeFile p `catch` nullError
    renameFile temp p

-- | Command to index all files from given folder 
indexCmd :: [String] -> Index -> IO ()      
indexCmd [p] idx = do 
    idx2 <- indexFolder False idx p
    writeIndex indexFile idx2   
indexCmd [p, "-r"] idx = do 
    idx2 <- indexFolder True idx p
    writeIndex indexFile idx2
indexCmd _ _ = error "add command requires path to the documents"

-- | Index given folder 
indexFolder :: Bool -> Index -> FilePath -> IO Index      
indexFolder False idx p = do 
    putStrLn $ "Added folder: " ++ p
    fs <- listFiles p
    idx2 <- foldM addFile idx fs
    return idx2
indexFolder True idx p = do 
    idx2 <- indexFolder False idx p
    ds <- listDirs p
    idx3 <- foldM (indexFolder True) idx2 ds
    return idx3

-- | Add file to the index
addFile :: Index -> FilePath -> IO Index
addFile idx p = do
    doc <- TextReader.readDocument p
    let idx2 = addDocument doc idx
    return idx2  
     

-- | Command tosearch index
searchCmd :: [String] -> Index -> IO ()
searchCmd (t:_) idx = do 
    let result = {-# SCC "search" #-} search idx (T.pack t)
    putStrLn $ "Search term: " ++ show t ++ " found in documents: "
    _ <- mapM (putStrLn . show) result
    return ()
searchCmd _ _ = error "search command requires search terms"