{-#LANGUAGE ScopedTypeVariables, QuasiQuotes, OverloadedStrings #-}

module Web.Horse.Forms.Basic where

import Data.ByteString.Lazy (ByteString)
import Data.ByteString.Lazy.Char8 ()
import Text.Hamlet
import Data.Monoid

textField :: String -> Maybe String -> String -> String -> Html ()
textField label err val name = ($ undefined) $
    [$hamlet| 
     $maybe err e
            %span.error $e$
            %br
     %label
            $label$
            %br
            %input!type=text!value=$val$!name=$name$
            %br|]

link :: String -> String -> Html ()
link linkName name = ($ undefined) $ [$hamlet|
       %a!href="?$name$=1" $linkName$
       %br|]

select :: String -> [String] -> Int -> String -> Html ()
select label options val name = ($ undefined) $  
                                [$hamlet|
     %label $label$
        %br
        %select!name=$name$
           $forall opts opt
              $if isSelected.opt
                  %option!selected!value=$string.num.opt$ $string.optVal.opt$
              $else
                  %option!value=$string.num.opt$ $string.optVal.opt$
        %br |]
    where
        opts = (zip3 (map (==val) [0..]) (map show [(0::Int)..]) options)
        isSelected (x,_,_) = x
        num (_,y,_) = y
        optVal (_,_,z) = z



wrapForm :: Html () -> Html ()
wrapForm f = mconcat [preEscapedString "<form method='POST' action=''>", f, 
               preEscapedString "<input type='submit'></input></form>"]