black-jewel-0.0.0.1: src/Main.hs

module Main where
import System.Console.Haskeline
import Control.Monad.IO.Class
import Control.Monad.Trans.State.Lazy(StateT, runStateT, evalStateT, get, put)
import Control.Monad.Trans.Class(lift)
import Control.Applicative((<$>))
import Control.Monad(mzero, when)
import Control.Monad.Trans.Maybe(MaybeT, runMaybeT)
import Data.Maybe(catMaybes)
import Data.Char(isSpace)
import Safe (readMay)
import Data.ByteString(hPut)
import System.IO(withFile, IOMode(WriteMode))
import Text.Printf(printf)
import PirateBay
import Quarry
import Utils

data InteractionState = InteractionState {
     usePager  :: Bool,
     lastQuery :: Maybe String,
     results :: [Quarry],
     lazyResults :: [IO (Maybe Quarry)],
     displayedResults :: [Quarry],
     searchState :: Maybe String,
     lastIndex :: Maybe Int,
     sortOpt :: SortingOption,
     seqStep :: Int
}

initalInteractionState :: InteractionState
initalInteractionState = InteractionState {
                       usePager  = True,
                       lastQuery =  mzero,
                       results = mzero,
                       seqStep = 4,
                       lazyResults = mzero,
                       displayedResults = [],
                       searchState = Nothing,
                       lastIndex = Nothing,
                       sortOpt = (Seed, Descending)
                       }

settings :: MonadIO m => Settings m
settings = defaultSettings { autoAddHistory = True }

main :: IO ()
main = runInputT settings $ evalStateT mainLoop initalInteractionState where
     mainLoop :: StateT InteractionState (InputT IO) ()
     mainLoop = lift (getInputLine ">>= ") >>= \input -> case input of
         Nothing -> return ()
         Just line -> evaluateCommand line >> mainLoop

evaluateCommand :: String -> StateT InteractionState (InputT IO) ()
evaluateCommand str' = let str = dropWhile isSpace str'
                           command = takeWhile (not . isSpace) str
                           rest = strip $ dropWhile (not . isSpace) str in
                           case command of
                                "find" -> find_evaluateCommand rest
                                "list" -> list_evaluateCommand
                                "more" -> more_evaluateCommand rest
                                "show" -> show_evaluateCommand rest
                                "save" -> save_evaluateCommand rest
                                _ -> lift $ outputStrLn ("Unknown command: " ++ command)

withValidIndex :: (Int -> StateT InteractionState (InputT IO) ())
               -> String
               -> StateT InteractionState (InputT IO) ()
withValidIndex fn str = case readMay str of
                     Nothing -> lift . outputStrLn $ "Invalid or missing argument."
                     Just index -> do
                                 results' <- results <$> get
                                 if index > length results'
                                     then lift . outputStrLn $ "Index too big. Try `more' first."
                                     else if index <= 0
                                          then lift . outputStrLn $ "Index assumed to be positive."
                                          else fn (index - 1)


save_evaluateCommand :: String -> StateT InteractionState (InputT IO) ()
save_evaluateCommand = withValidIndex save_evaluateCommand' where
    save_evaluateCommand' :: Int -> StateT InteractionState (InputT IO) ()
    save_evaluateCommand' index = do
        results' <- results <$> get
        let hash = (magnetHash . retrive) (results' !! index)
        torrent <- lift2 $ runMaybeT (fetchTorrentFile hash)
        case torrent of
            Nothing      -> lift . outputStrLn $ "Failed to fetch torrent file."
            Just torrent' -> lift2 $ withFile (printf "./%s.torrent" hash) WriteMode (`hPut` torrent')



find_evaluateCommand :: String -> StateT InteractionState (InputT IO) ()
find_evaluateCommand query = do
                     state <- get
                     (uneval', search_state) <- lift2 $ runStateT (search query (sortOpt state)) Nothing
                     let uneval = map runMaybeT uneval'
                     results' <- catMaybes <$> (lift2 . sequence $ take (seqStep state) uneval)
                     put state {
                         lastQuery = Just query,
                         lazyResults = drop (seqStep state) uneval,
                         results = results',
                         searchState = search_state
                         }
                     list_evaluateCommand

list_evaluateCommand :: StateT InteractionState (InputT IO) ()
list_evaluateCommand = get >>= lift2 . termOutput . results



show_evaluateCommand :: String -> StateT InteractionState (InputT IO) ()
show_evaluateCommand = withValidIndex show_evaluateCommand' where
                     show_evaluateCommand' :: Int -> StateT InteractionState (InputT IO) ()
                     show_evaluateCommand' index = do
                                                 q <- ( !! index) . results <$> get
                                                 lift2 . termOutput $  q
                                                 lift2 . invokePager . meta $ q


more_evaluateCommand :: String -> StateT InteractionState (InputT IO) ()
more_evaluateCommand ""  = get >>= more_evaluateCommand' . seqStep
more_evaluateCommand str = lastQuery <$> get >>=
                     \query -> case query of
                            Nothing -> lift . outputStrLn $ "No search performed."
                            Just _  -> case readMay str of
                                    Nothing -> lift . outputStrLn $ "Failed to read Int from: " ++ str
                                    Just val -> if val > 0
                                                then more_evaluateCommand' val
                                                else lift . outputStrLn $ "Argument expected to be positive."

more_evaluateCommand' :: Int -> StateT InteractionState (InputT IO) ()
more_evaluateCommand' n = do
    state' <- get
    when (null . lazyResults $ state') $ fetch_more (searchState state')
    state <- get
    moreResults <- catMaybes <$> (lift2 . sequence $ take n (lazyResults state'))
    put state { results = results state ++ moreResults, lazyResults = drop n (lazyResults state)}
    list_evaluateCommand

fetch_more :: Maybe String -> StateT InteractionState (InputT IO) ()
fetch_more Nothing = lift . outputStrLn $ "No more results availible."
fetch_more search_state = do
    state <- get
    (uneval', new_search_state) <- lift2 $ runStateT (search undefined undefined) search_state
    let uneval = map runMaybeT uneval'
    put state { searchState = new_search_state, lazyResults = uneval}



-- show_evaluateCommand :: String -> StateT InteractionState (InputT IO) ()
-- show_evaluateCommand "" = lift2 $ mapM_ (\arg ->