Input.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

module Cmt.IO.Input
    ( loop
    ) where

import ClassyPrelude

import System.Console.Terminal.Size (size, width)

import Cmt.IO.Git         (changed)
import Cmt.Parser.Options (parse)
import Cmt.Types.Config

prompt :: Text -> IO Text
prompt s = do
    putStr $ s <> " "
    hFlush stdout
    getLine

getWidth :: IO Int
getWidth = maybe 0 width <$> size

putName :: Text -> IO ()
putName name = putStrLn $ "\n" <> name <> ":"

listItem :: (Int, Text) -> Text
listItem (n, o) = tshow n <> ") " <> o

displayOptions :: [(Int, Text)] -> IO ()
displayOptions opts = do
    let long = intercalate "   " $ listItem <$> opts
    maxLength <- getWidth
    if length long < maxLength
        then putStrLn long
        else sequence_ $ putStrLn . listItem <$> opts

choice :: [(Int, Text)] -> Int -> Maybe Text
choice opts chosen = snd <$> find ((== chosen) . fst) opts

options :: [Text] -> IO Text
options opts = do
    let opts' = zip [1 ..] opts
    displayOptions opts'
    chosen <- parse <$> prompt ">"
    case chosen of
        Nothing -> options opts
        Just chosen' -> do
            let picked = catMaybes $ choice opts' <$> chosen'
            if null picked
                then options opts
                else pure $ intercalate ", " picked

multiLine :: [Text] -> IO [Text]
multiLine input = do
    value <- prompt ">"
    if null value && not (null input)
        then pure input
        else multiLine $ input ++ [value]

line :: IO Text
line = do
    value <- prompt ">"
    if null value
        then line
        else pure value

output :: Part -> IO (Name, Text)
output (Part name Line)           = putName name >> (,) name <$> line
output (Part name (Options opts)) = putName name >> (,) name <$> options opts
output (Part name Lines)          = putName name >> (,) name <$> (unlines <$> multiLine [])
output (Part name Changed)        = putName name >> (,) name <$> (options =<< changed)

loop :: Config -> IO [(Name, Text)]
loop (Config parts _) = sequence $ output <$> parts