{- 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.Types
    (Config(..),
     Bug(..),
     BugId(..),
     Comment(..),
     Field(..),
     Validator,
     FieldValue(..),
     FieldType(..),
     FieldDfns,
     FieldValues,
     SupportedVersion(..),
     Logger(..),
     Log(..),
     isPseudoFieldValue,
     isPseudoField,
    )
where

import qualified Data.Map as M
import Data.Time
import System.IO
import DisTract.Utils

data SupportedVersion = MTN_0_34
                      | MTN_0_35
                      | MTN_0_36
                        deriving (Eq, Ord, Enum)

instance Show SupportedVersion where
    show MTN_0_34 = "Version 0.34 (base revision: 6ae6de16b31495a773ac3002505ad51f2e4a8616)"
    show MTN_0_35 = "Version 0.35 (base revision: f92dd754bf5c1e6eddc9c462b8d68691cfeb7f8b)"
    show MTN_0_36 = "Version 0.36 (base revision: e4bc808d89e029ce623f9e8f2b10c84006b83fb5)"

instance Read SupportedVersion where
    readsPrec _ txt
        | v0_34 == take v0_34_len txt = [(MTN_0_34, drop v0_34_len txt)]
        | v0_35 == take v0_35_len txt = [(MTN_0_35, drop v0_35_len txt)]
        | v0_36 == take v0_36_len txt = [(MTN_0_36, drop v0_36_len txt)]
        | otherwise = error $ txt ++
                      " is an unsupported version of Monotone. Supported versions are " ++
                      (show [MTN_0_34 ..])
        where
          v0_34 = "6ae6de16b31495a773ac3002505ad51f2e4a8616"
          v0_34_len = length v0_34
          v0_35 = "f92dd754bf5c1e6eddc9c462b8d68691cfeb7f8b"
          v0_35_len = length v0_35
          v0_36 = "e4bc808d89e029ce623f9e8f2b10c84006b83fb5"
          v0_36_len = length v0_36

class Logger a where
    logStr :: a -> String -> IO ()
    logStr t txt = logWithPrefix t [] txt

    logWithPrefix :: a -> String -> String -> IO ()

data Log = StdOutLog | FileLog FilePath
               deriving (Show, Eq)

instance Logger Log where
    logWithPrefix _ _ [] = return ()
    logWithPrefix t pre txt
        | '\n' /= last txt = logWithPrefix t pre (txt ++ "\n")
    logWithPrefix StdOutLog pre txt = putStr $ pre' ++ txt
        where pre' = if null pre then pre else pre ++ ": "
    logWithPrefix (FileLog path) pre txt = appendFile path $
                                           pre' ++ txt
        where pre' = if null pre then pre else pre ++ ": "

data Config = Config { mtnExecutable :: String,
                       mtnDb :: FilePath,
                       user :: String,
                       baseDir :: FilePath,
                       fieldDfns :: FieldDfns,
                       args :: [String],
                       verbose :: Bool,
                       mtnVersion :: SupportedVersion,
                       logger :: Log,
                       packageName :: String,
                       packageVersion :: String
                     }

instance Show Config where
    show config = "Config: mtnExecutable=" ++ (mtnExecutable config) ++
                  "; mtnDb=" ++ (mtnDb config) ++
                  "; user=" ++ (user config) ++
                  "; baseDir=" ++ (baseDir config) ++
                  "; fieldDfns=(" ++ (show . fieldDfns $ config) ++
                  "); args=" ++ (show . args $ config) ++
                  "; verbose=" ++ (show . verbose $ config) ++
                  "; mtnVersion=" ++ (show . mtnVersion $ config) ++
                  "; logType=" ++ (show . logger $ config) ++
                  "; packageName=" ++ (show . packageName $ config) ++
                  "; packageVersion=" ++ (show . packageVersion $ config)

data Bug = Bug { bugId :: BugId,
                 bugComments :: Comment,
                 bugFields :: FieldValues
               }
           deriving (Show, Eq)

data Comment = Comment { commentId :: FilePath,
                         commentAuthor :: String,
                         commentTime :: UTCTime,
                         commentText :: String,
                         commentReplies :: [Comment]
                       }
               deriving (Show, Eq)

data BugId = BugId UTCTime String
             deriving (Eq, Ord)

instance Show BugId where
    show (BugId creation author) =
        "bug-" ++ time ++ "-" ++ author
        where
          time = bugIdTimeFormatter creation

type FieldDfns = M.Map String Field

data Field = Field { fieldName :: String,
                     fieldDefault :: FieldValue,
                     fieldType :: FieldType,
                     fieldValidator :: Validator
                   }
           | PseudoField { fieldName :: String,
                           fieldValueExtractor :: Bug -> IO FieldValue
                         }

isPseudoFieldValue :: FieldValue -> Bool
isPseudoFieldValue (FieldValue _ (PseudoField {})) = True
isPseudoFieldValue _ = False

isPseudoField :: Field -> Bool
isPseudoField (PseudoField {}) = True
isPseudoField _ = False

instance Show Field where
    show (Field name init fType _) = "Field " ++ (show name)
                                     ++ " of type " ++ (show fType)
                                     ++ " " ++ (show init)
    show (PseudoField name _) = "PseudoField " ++ (show name)

instance Eq Field where
    (==) (Field n1 (FieldValue d1 _) t1 _)
         (Field n2 (FieldValue d2 _) t2 _) = n1 == n2
                                             && t1 == t2
                                             && d1 == d2
    (==) (PseudoField n1 _) (PseudoField n2 _) = n1 == n2
    (==) _ _ = False

instance Ord Field where
    compare (PseudoField {}) (Field {}) = LT
    compare (Field {}) (PseudoField {}) = GT
    compare f1 f2 = (fieldName f1) `compare` (fieldName f2)

type Validator = String -> Maybe FieldValue

type FieldValues = M.Map String FieldValue

data FieldValue = FieldValue String Field

instance Eq FieldValue where
    (==) (FieldValue v1 f1) (FieldValue v2 f2) = f1 == f2
                                                 && v1 == v2

instance Ord FieldValue where
    compare (FieldValue v1 f1) (FieldValue v2 f2)
        | EQ == fcomp = compare v1 v2
        | otherwise = fcomp
        where
          fcomp = compare f1 f2

instance Show FieldValue where
    show (FieldValue init f) = "FieldValue for field " ++ (fieldName f) ++
                               " with value '" ++ init ++ "'"

data FieldType = FieldFreeForm
               | FieldSimpleValues [String]
               | FieldGraph (M.Map String [(String, String)])
                 deriving (Show, Eq)