{-# 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)