hranker-0.1.1: Hranker/CommandLine.hs

{-# LANGUAGE ScopedTypeVariables #-}
module Hranker.CommandLine (clMain, oneRound) where

import Hranker.Commands (allCommands, cmdFn, Command, findCmd, printInverseMapping, pushAt)
import Hranker.State (AnnotatedItem(..), MyState(..), OutputState)

import Data.List.NonEmpty (listToNonEmpty)
import System.Console.HCL (execReq, prompt, reqCont, reqFail, reqIO, reqIterate, reqResp, Request, reqUntil)

import Control.Monad (liftM)
import Data.Maybe (fromJust, isJust)

-- | Perform one "round" of the user interaction (i.e. asking for and executing one command)
oneRound :: forall a. (Show a, Eq a, Ord a) => OutputState a -> Request (OutputState a)
oneRound prevOS = do
    -- Immediately quit if the unranked list is empty
    u <- maybe (printInverseMapping prevOS >> reqFail) return . listToNonEmpty $ unranked prevOS
    -- Convert the previous OutputState into an InputState
    let inS = prevOS { unranked = u }
    -- Show the current state
    reqIO . putStrLn $ show inS
    -- Ask for a command until a valid one is entered
    c <- reqUntil (return . isJust . (findCmd :: Char -> Maybe (Command a)))
         . prompt (show (allCommands :: [Command a]) ++ "> ") . liftM head $ reqResp `reqCont` return "!" -- bogus command
    -- Execute the selected command
    cmdFn ((fromJust $ findCmd c) :: Command a) inS

notEnough :: IO a
notEnough = fail "At least one item to rank must be provided"

-- | Run the program, given the items to rank
clMain :: (Show a, Eq a, Ord a) => [a] -> IO ()
clMain xs     = do
    putStrLn "WARNING 1: This program does not have any save or export feature. You have to manually read and transfer the results."
    putStrLn "WARNING 2: If there are no more items to rank, the program immediately outputs a mapping from items to ranks, and then quits."
    putStrLn "Your scrollback buffer must be large enough."
    putStrLn ""
    execReq . reqIterate oneRound . pushAt id . MyState [] =<< maybe notEnough return (listToNonEmpty $ map (`AnnotatedItem` "") xs)