content: {-# LANGUAGE NoImplicitPrelude #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE OverloadedLists #-}
  
  module Cmt.IO.Input
      ( loop
      ) where
  
  import ClassyPrelude
  
  import Data.Map.Strict              (Map)
  import System.Console.Terminal.Size (size, width)
  
  import Cmt.IO.Git         (changed)
  import Cmt.Parser.Options (parse)
  import Cmt.Types.Config
  
  type Choice = Map Int Text
  
  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 :: Choice -> IO ()
  displayOptions opts = do
      let parts = mapWithKey listItem opts
      let long = intercalate "   " parts
      maxLength <- getWidth
      if length long < maxLength
          then putStrLn long
          else sequence_ $ putStrLn <$> parts
  
  choice :: Choice -> Int -> Maybe Text
  choice opts chosen = lookup chosen opts
  
  choiceGen :: [Text] -> Choice
  choiceGen ts = mapFromList $ zip [1 ..] ts
  
  options :: [Text] -> IO Text
  options opts = do
      let opts' = choiceGen 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 Output
  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 Outputs
  loop (Config parts _) = mapFromList <$> traverse output parts
  