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)