{-# OPTIONS -Wall #-}
{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS -fno-warn-name-shadowing -fno-warn-orphans #-}

-- | Mini formlets library.

module Text.Formlet
       (Formlet(..)
       ,formlet
       ,req
       ,opt
       ,wrap
       ,integer
       ,textInput
       ,dropInput
       ,areaInput
       ,submitInput
       ,parse
       ,options
       ,findOption) where

import           Control.Applicative
import           Control.Monad.Error
import           Control.Monad.Reader
import           Control.Monad.Trans.Error   (ErrorList(..))
import           Control.Monad.Writer
import           Data.ByteString             (ByteString)
import           Data.List                   (find)
import           Data.Map                    (Map)
import qualified Data.Map                    as M
import           Data.Maybe
import           Data.Monoid.Operator
import           Data.Text                   (Text)
import qualified Data.Text                   as T
import           Data.Text.Encoding
import           Prelude                     hiding ((++))
import           Text.Blaze.Html5            as H hiding (map)
import qualified Text.Blaze.Html5.Attributes as A

type Params = Map ByteString [ByteString]

-- | A simple formlet data type, collects errors.
data Formlet a = Formlet {
   formletValue  :: Params -> Either [Text] a
 , formletName   :: Maybe Text
 , formletHtml   :: Params -> Html
}

instance Applicative Formlet where
  pure a = Formlet { formletValue = const (return a)
                   , formletHtml  = const mempty
                   , formletName  = Nothing
                   }
  Formlet f n fhtml <*> Formlet v n' vhtml =
    Formlet { formletValue = \params ->
                case v params of
                  Right x -> f params <*> Right x
                  Left e  -> case f params <*> Left [] of
                               Right x -> return x
                               Left e' -> Left $ e' ++ e
            , formletHtml  = \params -> fhtml params ++ vhtml params
            , formletName  = case (n,n') of
                               (Just{},Just{}) -> Nothing
                               _               -> n `mplus` n'
            }

-- | Normal instance.
instance Functor Formlet where
  fmap f formlet@Formlet{..} = formlet { formletValue = value }
    where value = \params ->
                    case formletValue params of
                      Left e -> Left e
                      Right a -> Right (f a)

-- | The error message for the formlets is a text value.
instance Error Text where noMsg = ""; strMsg = T.pack
instance ErrorList Text where listMsg = return . T.pack

-- | Make a simple formlet.
formlet :: Text -> (Maybe Text -> Html) -> Formlet Text
formlet name html = 
  Formlet { formletValue = \inputs ->
              case (M.lookup (encodeUtf8 name) inputs) of
                Just (value:_) -> return $ decodeUtf8 value
                _ -> throwError $ ["missing input: " ++ name]
          , formletHtml = \inputs ->
              case M.lookup (encodeUtf8 name) inputs of
                Just (value:_) -> html (Just $ decodeUtf8 value)
                _ -> html Nothing
          , formletName = Just name
          }

-- | Make an input required (non-empty text).
req :: Formlet Text -> Formlet Text
req formlet@Formlet{..} =
  formlet { formletValue = \inputs ->
              case formletValue inputs of
                Right v | T.null v ->
                  throwError $ ["required input" ++ maybe "" (": "++) formletName]
                meh -> meh
          }

-- | Make an input optional (empty text is nothing).
opt :: Formlet Text -> Formlet (Maybe Text)
opt formlet@Formlet{..} =
  formlet { formletValue = \inputs ->
              case formletValue inputs of
                Right v | T.null v -> Right Nothing
                meh -> Just <$> meh
          }



-- | Parse a form value.
parse :: (a -> Either Text b) -> Formlet a -> Formlet b
parse parser formlet@Formlet{..} =
  formlet { formletValue = \inputs ->
              case formletValue inputs of
                Left e -> Left e
                Right x -> case parser x of
                             Right y -> Right y
                             Left e -> Left [e ++ maybe "" (": "++) formletName]
          }

-- | Integer parser.
integer :: Text -> Either Text Integer
integer (readMay . T.unpack -> Just v) = Right v
integer _ = Left "expected integer"

readMay :: Read a => String -> Maybe a
readMay x = case reads x of
              [(x,"")] -> return x
              _        -> Nothing

-- | Wrap/transform formlet's HTML.
wrap :: (Html -> Html) -> Formlet Text -> Formlet Text
wrap f formlet@Formlet{..} = formlet { formletHtml = f . formletHtml }

-- | Make a text input formlet with a label.
textInput :: Text -> Text -> Maybe Text -> Formlet Text
textInput name caption def =
  formlet name $ \value -> do
    p $ H.label $ do
      H.span $ toHtml $ caption ++ ": "
      input ! A.name (toValue name)
            ! A.value (toValue $ fromMaybe "" (value <|> def))
            ! A.class_ "text"

-- | Make a textarea input with a label.
areaInput :: Text -> Text -> Maybe Text -> Formlet Text
areaInput name caption def =
  formlet name $ \value -> do
    p $ H.label $ do
      H.span $ toHtml $ caption ++ ": "
      textarea ! A.name (toValue name) $
        toHtml $ fromMaybe "" (value <|> def)

-- | Make a drop down input with a label.
dropInput :: [(Text,Text)] -> Text -> Text -> Text -> Formlet Text
dropInput values name caption def =
  formlet name $ \value -> do
    p $ H.label $ do
      H.span $ toHtml $ caption ++ ": "
      select ! A.name (toValue name) $
        forM_ values $ \(key,title) -> do
          let nonSelected = all ((/=value) . Just . fst) values
              defaulting = nonSelected && def == key
              selected
                | Just key == value = (! A.selected "selected")
                | defaulting        = (! A.selected "selected")
                | otherwise         = id
          selected $ option ! A.value (toValue key) $ toHtml title

-- | Make a submit (captioned) button.
submitInput :: Text -> Text -> Html
submitInput name caption = p $ do
  p $ H.input ! A.type_ "submit"
              ! A.name (toValue name)
              ! A.value (toValue caption)

-- | Make a list of options for use with the option formlet.
options :: (o -> Text) -> (o -> Text) -> [o] -> [(Text,Text)]
options slug caption os = ("","") : map (\o -> (slug o,caption o)) os

-- | Lookup a real internal id from a slug.
findOption :: (o -> Bool) -> [o] -> (o -> internalid) -> Either Text internalid
findOption pred os field =
  case find pred os of
    Nothing -> Left ""
    Just x -> Right (field x)