module Main where

import Control.Applicative
import Control.Applicative.Error
import Text.Formlets
import System.IO

-- * Test

data Txt 
    = Label String
    | Input (String, Maybe String)
    | ErrorMsg [String]

input :: Form [Txt] IO (Maybe String)
input = generalInput $ (\n v -> [Input (n, v)])

label :: String -> Form [Txt] IO ()
label str = xml [Label str]

runTxt :: Txt -> IO Values
runTxt (Label str) = putStr str >> return []
runTxt (Input (n, mv)) = 
    do case mv of 
         Nothing -> 
             do putStr ": "
                v <- getLine
                if null v 
                 then return []
                 else return [(n, Left v)]
         (Just oldV) ->
             do putStr $ "[" ++ oldV ++ "]: "
                v <- getLine
                if null v
                   then return [(n, Left oldV)]
                   else return [(n, Left v)]
runTxt (ErrorMsg errs) =
    do putStrLn "{"
       mapM putStrLn errs
       putStrLn "}"
       return []

runTxts :: [Txt] -> IO Values
runTxts txts = concat <$> mapM runTxt txts

form :: Form [Txt] IO (String, String)
form =
    (,) <$> username <*> passwords

username :: Form [Txt] IO String
username =
    checkInline (label "Username" *> input)
                (\mStr -> 
                     case mStr of
                       Nothing ->
                             Failure ["You must enter a username."]
                       (Just str)
                           | length str < 6  -> Failure ["Username must be at least 6 charaters long."]
                           | str == "foobar" -> Failure ["Username can not be foobar."]
                           | otherwise -> Success str)
                (\errs txts -> ErrorMsg errs : txts)

-- echos password, etc, but it's just a demo.
password :: Form [Txt] IO String
password =
    checkInline (label "Password" *> input)
                (\mStr ->
                     case mStr of 
                       Nothing -> Failure ["You must enter a password."]
                       (Just str) -> Success str)
                (\errs txts -> ErrorMsg errs : txts)

passwords :: Form [Txt] IO String
passwords =
    checkInline ((,) <$> password <*> password)
                (\(pass1, pass2) ->
                     if pass1 /= pass2
                        then Failure ["Passwords do not match."]
                        else Success pass1)
                (\errs txts -> ErrorMsg errs : txts)


main :: IO ()
main =
    do hSetBuffering stdout NoBuffering
       let (_,txts,_) = runFormState ([],[]) "" $ form
       values <- runTxts txts
       validateLoop values
    where
      validateLoop values =
           do let (collector, _, _) = runFormState ([],values) "" $ form
              res <- collector
              case res of
                (SuccessAt a) -> print a
                (FailureAt errs) ->
                    do putStrLn "Input failed to validate."
                       let (_, txts, _) = runFormState (errs, values) "" $ form
                       values <- runTxts txts
                       validateLoop values