{- DisTract ------------------------------------------------------\
 |                                                                 |
 | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |
 |                                                                 |
 | DisTract is freely distributable under the terms of a 3-Clause  |
 | BSD-style license. For details, see the DisTract web site:      |
 |   http://distract.wellquite.org/                                |
 |                                                                 |
 \-----------------------------------------------------------------}

{-# LANGUAGE TemplateHaskell #-}

module DisTract.HTML.Fields
    (toFormInput,
     toSummary
    )
where

import Text.XHtml
import Text.HTML.Chunks
import DisTract.Types
import DisTract.Utils
import qualified Data.Map as M
import qualified JSON as J

$(chunksFromFile "./html/templates/fields.html")

escape :: String -> String
escape = renderHtmlFragment . stringToHtml

toFormInput :: FieldValue -> String
toFormInput (FieldValue _ (PseudoField {})) = []
toFormInput (FieldValue value field)
    = format $ Chunk_field { field_name = name,
                             field_input = input,
                             field_valueJson = valueJson
                           }
    where
      input = toFormInputType (fieldType field) field value
      name = fieldName field
      valueJson = J.stringify (J.String value)

toSummary :: FieldValue -> String
toSummary (FieldValue value field)
    = format $ Chunk_summary { summary_name = name,
                               summary_value = escape value
                             }
    where
      name = fieldName field

toFormInputType :: FieldType -> Field -> String -> String
toFormInputType FieldFreeForm field value
    = format $ Chunk_freeform
      { freeform_name = fieldName field,
        freeform_valueJson = J.stringify (J.String value)
      }
toFormInputType (FieldSimpleValues values) field value
    = format $ Chunk_simpleValues
      { simpleValues_name = fieldName field,
        simpleValues_options = options
      }
    where
      options = concat $ map formatOption values
      formatOption :: String -> String
      formatOption v = format $ Chunk_selectOption
                       { selectOption_valueJson = J.stringify (J.String v),
                         selectOption_text = v,
                         selectOption_selected = selected
                       }
          where
            selected = if value == v then "selected" else ""
toFormInputType (FieldGraph valuesMap) field value
    = format $ Chunk_graphValues
      { graphValues_name = fieldName field,
        graphValues_options = options
      }
    where
      options = concat . intersperseEvery 1 "<br>\n" $ current : next
      nextValues = M.findWithDefault [] value valuesMap
      next = map formatNextOption nextValues
      current = format $ Chunk_radioOption
                { radioOption_name = fieldName field,
                  radioOption_valueJson = J.stringify (J.String value),
                  radioOption_checked = "checked",
                  radioOption_text = "Leave as " ++ value
                }
      formatNextOption :: (String, String) -> String
      formatNextOption (verb, noun)
          = format $ Chunk_radioOption
            { radioOption_name = fieldName field,
              radioOption_valueJson = J.stringify (J.String noun),
              radioOption_checked = "",
              radioOption_text = verb
            }