-- | Proof-of-concept module: use digestive functors for a command line
-- interface prompt
--
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Text.Digestive.Cli
    ( Prompt
    , prompt
    , promptList
    , promptRead
    , runPrompt
    ) where

import Control.Applicative ((<$>))
import Data.Monoid (Monoid, mappend, mempty)

import Text.Digestive.Result
import Text.Digestive.Types
import Text.Digestive.Transform
import Text.Digestive.Forms (inputList)

-- A representation of an element in the structure used to gather inputs
-- from the user.
--
data FieldItem
  -- A tangible item that the user is prompted for.
  = FieldItemSingle     FormId String [String]
  -- A delimter marking the start of a series of prompts to be entered
  -- multiple times.
  | FieldItemMultiStart FormId String [String]
  -- A delimiter marking the end of a multiple input prompt.
  | FieldItemMultiEnd
    deriving (Show)

-- The structure of a prompt, built up as a View.
--
newtype PromptView = PromptView
    { unPromptView :: [FieldItem]
    } deriving (Show, Monoid)

-- | Type for a prompt
--
type Prompt a = Form IO String String PromptView a

-- An association list of FormIds and their inputs gathered by prompting the
-- user.
--
newtype InputMap = InputMap
    { unInputMap :: [(FormId, String)]
    } deriving (Show, Monoid)

-- Create an environment from an input map
--
inputMapEnvironment :: Monad m => InputMap -> Environment m String
inputMapEnvironment map' = Environment $ return . flip lookup (unInputMap map')

-- | Generate a prompt field for a String
--
prompt :: String        -- ^ Description
       -> Prompt String -- ^ Resulting prompt
prompt descr = Form $ do
    id' <- getFormId
    inp <- getFormInput
    range <- getFormRange
    let v :: [(FormRange, String)] -> PromptView
        v errs = PromptView [FieldItemSingle id' descr matching]
          where
            -- Only errors which apply specifically to this item
            matching = retainErrors range errs
        result = case inp of
            Just x  -> Ok x
            Nothing -> Error [(range, "No input")]
    return (View v, return result)

-- | Convert a prompt for a single item into a prompt for multiple items
--
promptList :: String     -- ^ Description of resulting multi-prompt
           -> Prompt a   -- ^ Prompt to convert
           -> Prompt [a] -- ^ Resulting multiple input prompt
promptList descr prmpt = Form $ do
    id'     <- getFormId
    (v, rs) <- unForm $ inputList numPrompt (const prmpt) Nothing
    range   <- getFormRange
    -- The monoid for the view will look like this: [vstart, v, vend]
    -- 'vstart' and 'vend' delimit the beginning and end of the inputs that
    -- are converted into repeatable inputs. When we are prompting the user to
    -- fill out the form, we use these delimiters to control the behavior of
    -- the prompts. Anything between them will be treated as repeatable. The
    -- 'vstart' item (FieldItemMultiStart) also contains the FormId of the
    -- field used to count the number of entries, as well as an additional
    -- description of of the multiple input itself (for example, 'Users', when
    -- the contained items are used to enter in a single User.)
    let vstart errs = PromptView [item]
          where
            item = FieldItemMultiStart id' descr $ retainErrors range errs
        vend _ = PromptView [FieldItemMultiEnd]
    return (View vstart `mappend` v `mappend` View vend, rs)
  where
    numPrompt _ = Form $ do
        inp <- getFormInput
        return (mempty, return (readN inp))
    readN (Just x) = Ok (read x)
    readN Nothing = Error []

-- | Generate a prompt field for a value which can be read
--
promptRead :: Read a
           => String   -- ^ Error when the value can't be read
           -> String   -- ^ Description
           -> Prompt a -- ^ Resulting prompt
promptRead error' descr = prompt descr `transform` transformRead error'

-- Get a single line of text from the user
--
cliInput :: IO String
cliInput = putStr "> " >> getLine

-- Get the input for a list of prompt items that have been defined.
--
-- Notably, this supports nested 'mass input' forms (inputList/promptList)
-- which are delimited by FieldItemMultiStart and FieldItemMultiEnd.
-- FieldItemMultiSingle represents a tangible item to prompt for. If a
-- FieldItemMultiStart is reached, we need to prompt for all of the items
-- until the next FieldItemMultiEnd an arbitrary number of times.
--
inputForItems :: [FieldItem]
              -- ^ Items to get input for
              -> [(FormId, String)]
              -- ^ Accumulated association list of inputs we've prompted for
              -> (FormId -> FormId)
              -- ^ A function to transform the FormId of this item. Used to
              -- change the index of the item when prompting multiple times.
              -> IO ([FieldItem], [(FormId, String)])
              -- ^ A pair of the remaining items (empty if we are not
              -- returning from a multiple input item) and accumulated inputs, 
inputForItems [] accum _fid = return ([], accum)

inputForItems (FieldItemMultiEnd : rest) accum _fid = return (rest, accum)

-- The simple case for a single item.
inputForItems (FieldItemSingle id' descr _errs : rest) accum fid = do
    putStrLn descr
    val <- cliInput
    inputForItems rest ((fid id', val) : accum) fid

-- The case for a multiple input prompt.
inputForItems (FieldItemMultiStart id' descr _errs : rest) accum fid = do
    let id'' = fid id'
    putStrLn $ "How many '" ++ descr ++ "' do you want to input?"
    -- Leave this as a string, since we must put it into a hidden form field
    -- for inputList, which must read it again. We only prompt for it here
    -- instead of as a discrete form item because we want to know, right now,
    -- how many the user wants to input.
    nStr <- cliInput
    -- Prompt for all of the delimited items, and put them at index i for this
    -- multi-input item.
    -- TODO use foldM
    let f i = do putStrLn $ descr ++ " #" ++ show (i + 1) ++ ":"
                 inputForItems rest [] (modifyId id'' i)
    delimited <- mapM f [0..(read nStr - 1)]
    let rest' = fst $ last delimited
        countfield = (id'', nStr)
    inputForItems rest' ([countfield] ++ accum ++ concatMap snd delimited) fid

-- Construct a function to transform the 'children' (delimited items) of a
-- mass input item to the correct index.
--
modifyId :: FormId -> Integer -> FormId -> FormId
modifyId parent i = mapId (\x -> head x : i : formIdList parent)

-- | Run a Prompt, sequentially prompting the user for each item.
--
runPrompt :: Prompt a
          -- ^ The Prompt to run
          -> IO (Either [String] a)
          -- ^ A list of error strings, or the result.
runPrompt prmpt = do
    prmptv <- viewForm prmpt "form"
    inpmap <- InputMap . snd <$> inputForItems (unPromptView prmptv) [] id
    eith   <- eitherForm prmpt "form" (inputMapEnvironment inpmap)
    return $ case eith of
        Left v  -> Left (fieldItemErrors `concatMap` unPromptView v)
        Right x -> Right x

-- Read the errors from a FieldItem, if any.
--
fieldItemErrors :: FieldItem -> [String]
fieldItemErrors (FieldItemSingle id' descr errs) =
    descriptiveErrors id' descr errs
fieldItemErrors (FieldItemMultiStart id' descr errs) = -- TODO bad
    descriptiveErrors id' descr errs
fieldItemErrors FieldItemMultiEnd = []

descriptiveErrors :: FormId -> String -> [String] -> [String]
descriptiveErrors id' descr errs = map str errs
  where
    str err = "(" ++ show id' ++ ") " ++ descr ++ ": " ++ err