Interact.hs

{-# LANGUAGE OverloadedStrings #-}

module ElmInit.Interact
  ( askChoicesWithOther
  , askChoices
  ) where


import           Control.Applicative ((<$>), (<*>))
import qualified Control.Arrow       as Arrow (first)
import           Data.Bool           (bool)
import           Data.Text           (append)
import           Data.Text           as Text (Text, intercalate, pack)
import           Data.Text.IO        as TextIO (getLine, putStrLn)
import           ElmInit.Util        (enumerate, getOr)
import           Prelude             hiding (getLine, putStrLn)


askChoices :: Text -> Int -> [Text] -> IO Text
askChoices =
  ((fmap <$> (!!) <*>) .) . askChoices'


askChoices' :: Text -> Int -> [Text] -> IO Int
askChoices' message selected choices =
  putStrLn message >>
  ask out

  where
    (l1, selectedElem : l2tail) = splitAt selected choices
    out =
      intercalate
        "\n"
        (normFormat 1 l1
          ++ (selectedFormat selected selectedElem : normFormat (selected + 1) l2tail))

    enumF = flip append " )  " . pack . show
    enumFn = append "    " . enumF
    enumFs = append "  * " . enumF
    normFormat = (map (uncurry append . Arrow.first enumFn) .) . enumerate
    selectedFormat x y = (flip append y . enumFs) x

    ask a =
      putStrLn a >>
      getOr selected >>=
        (bool
          (putStrLn "invalid choice, please choose again" >>
          ask a)
          <$> return
          <*> (<= length choices))


askChoicesWithOther :: Text -> Int -> (Text -> Either Text a) -> [Text] -> IO a
askChoicesWithOther m s trans l =
    askChoices' m s (l ++ ["other (specify)"])
    >>= (flip bool getAlternative
          <$> either (const $ error "No parse") return . trans . (l !!)
          <*> (== length l))

  where
    getAlternative =
      putStrLn "please enter an alternative" >>
      getLine >>=
        (either
          (\message ->
            putStrLn "Invalid input:" >>
            putStrLn message >>
            getAlternative
          )
          return
          . trans)