{- 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/                                |
 |                                                                 |
 \-----------------------------------------------------------------}

module DisTract.Bug.PseudoField
    (pseudoFieldDfn,
     loadPseudoFields
    )
    where

import DisTract.Types
import DisTract.Utils
import System.Locale
import Control.Monad
import Control.Monad.Fix
import qualified Data.Map as M
import Data.Time

data PseudoField = Reporter
                 | Created
                   deriving (Show, Eq, Ord, Enum)

instance Read PseudoField where
    readsPrec _ txt
        | reporterTxt == take reporterTxtLen txt
            = [(Reporter, drop reporterTxtLen txt)]
        | createdTxt == take createdTxtLen txt
            = [(Created, drop createdTxtLen txt)]
        | otherwise = error $ "Unknown PseudoField name '" ++ txt ++
                      "'. Known PseudoFields are: " ++ (show [Reporter ..])
        where
          reporterTxt = "Reporter"
          createdTxt = "Created"
          reporterTxtLen = length reporterTxt
          createdTxtLen = length createdTxt

pseudoFieldDfn :: PseudoField -> Field
pseudoFieldDfn Reporter = pf
    where
      pf = PseudoField { fieldName = (show Reporter),
                         fieldValueExtractor = extractReporter
                       }
      extractReporter :: Bug -> IO FieldValue
      extractReporter bug = return $ FieldValue reporter pf
          where
            (BugId _ reporter) = bugId bug
pseudoFieldDfn Created = pf
    where
      pf = PseudoField { fieldName = (show Created),
                         fieldValueExtractor = extractCreated
                       }
      extractCreated :: Bug -> IO FieldValue
      extractCreated bug = do { calendarTime <- utcToLocalZonedTime createdClock
                              ; return $ FieldValue (created calendarTime) pf
                              }
          where
            (BugId createdClock _) = bugId bug
            created = formatTime defaultTimeLocale
                      humanTimeFormat

loadPseudoFields :: Config -> Bug -> IO Bug
loadPseudoFields config = fix (loadPseudoFields' config)

loadPseudoFields' :: Config -> (Bug -> IO Bug) -> (Bug -> IO Bug)
loadPseudoFields' (Config{ fieldDfns = dfns }) recFunc bug
    = do { values <- fieldValues
         ; let bug' = bug { bugFields = values }
         ; case bug == bug' of
             True -> return bug
             False -> recFunc bug'
         }
    where
      fieldValues = M.fold runPseudoField (return $ bugFields bug) dfns
      runPseudoField :: Field -> IO (M.Map String FieldValue) ->
                        IO (M.Map String FieldValue)
      runPseudoField (Field {}) accM = accM
      runPseudoField (PseudoField { fieldName = name,
                                    fieldValueExtractor = extractor
                                  }) accM
          = do { acc <- accM
               ; value <- extractor bug
               ; return $ M.insert name value acc
               }