{-# LANGUAGE TemplateHaskell, DeriveDataTypeable, BangPatterns #-} module CodeMushu.Type where import Rika.Type.Default import Data.Map (Map) import Control.Concurrent.STM import MPS.Env import Prelude () import Data.StateVar import Rika.Data.Record.Label import Text.JSON.Generic import Data.ByteString.Char8 (ByteString) data Code = Code { path :: String , parent :: String , depth :: Integer , filesize :: Integer , content :: String , is_directory :: Integer } deriving (Show, Eq) instance Default Code where def = Code { path = def , parent = def , depth = 0 , filesize = 0 , content = def , is_directory = 0 } data UnpackStatus = Unpacking | UnpackComplete deriving (Show, Eq, Data, Typeable) data DBJobStatus = DBInit | DBAnalysing | DBImporting Int | DBIndexing | DBComplete deriving (Show, Eq, Data, Typeable) data JobError = FailedToFetchRepo | Exception String deriving (Show, Eq, Data, Typeable) data JobStatus = Initialized | UnpackStage UnpackStatus | DBStage DBJobStatus | Bouncing | Cleanup | Completed Project | Failed JobError deriving (Show, Eq, Data, Typeable) instance Default JobStatus where def = Initialized data FetchStatus = FetchInQueue Integer | Fetching JobStatus | FetchFailed String type StatusCallback = JobStatus -> IO () type FetchCallback = FetchStatus -> IO () type FetchMonitorCallback = IO () -> IO () data Repo = Git | Darcs | SVN | Hg | Archive | Raw deriving (Show, Eq, Data, Typeable, Read) instance Default Repo where def = Git data Project = Project { project_id :: Integer , project_name :: String , repo :: Repo , project_url :: String } deriving (Show, Eq, Data, Typeable) instance Default Project where def = Project { project_id = def , project_name = def , repo = def , project_url = def } data RepoState = RepoState { states_map :: Map Integer (TVar JobStatus) } instance Default RepoState where def = RepoState { states_map = def } -- Datatypes data JobQueryResponse = JobQueryFailed String | JobQuerySuccess JobStatus deriving (Eq, Show, Data, Typeable) data JobCreateResponse = JobCreateFailed String | JobCreateSuccess Integer deriving (Eq, Show, Data, Typeable) instance HasGetter TVar where get = atomically < readTVar instance HasSetter TVar where ($=) x = atomically < writeTVar x data SourceCode = SourceCode { project_ref :: Project , fetch_status :: FetchStatus } data ClientState = ClientState { source_codes :: [SourceCode] } data RepoControlHandle = RepoControlHandle { set_ui_repo_status :: Integer -> LocalRepoStatus -> IO () , set_global_error :: String -> IO () } data RepoControlInput = RepoControlInput { create_repo :: TaskID -> Repo -> String-> IO () } {- instance Default (Event a) where def = NoEvent -} type TaskID = Int type CallbackMap = Map Int RepoControlHandle data FetchTask = CreateRepo !Repo !ByteString | MonitorRepo !Integer !Integer | DownloadRepo !Integer | NoTask deriving (Show, Eq) instance Default FetchTask where def = NoTask data ReactInput = ReactInput { input_id :: !TaskID , fetch_task :: !FetchTask } deriving (Show, Eq) instance Default ReactInput where def = ReactInput { input_id = 0 , fetch_task = def } data ReactState = ReactState { update_id :: !TaskID , fetch_update :: !FetchUpdate } deriving (Show, Eq) instance Default ReactState where def = ReactState { update_id = 0 , fetch_update = def } data FetchUpdate = PerformCreateRepo !Repo !ByteString | PerformMonitorRepo !Integer !Integer | PerformDownloadRepo !Integer | SetRepoInQueue | NoUpdate deriving (Show, Eq) instance Default FetchUpdate where def = NoUpdate data LocalRepo = LocalRepo { repo_id :: Integer , repo_url :: String , repo_type :: Repo , repo_name :: String , repo_status :: LocalRepoStatus } deriving (Show, Eq, Data, Typeable) instance Default LocalRepo where def = LocalRepo { repo_id = def , repo_url = def , repo_type = def , repo_name = def , repo_status = def } data LocalRepoStatus = LocalInQueue | LocalUnpacking | LocalAnalysing | LocalImporting Double | LocalBouncing | LocalDownloading Double | LocalDone | LocalError String | LocalRefreshReachMaximumNumber deriving (Show, Eq, Data, Typeable) instance Default LocalRepoStatus where def = LocalInQueue type LocalRepoIndex = Integer {-} type FetchIn = Event ReactInput type FetchOut = Event ReactState type SenseRef = TVar [ReactInput] type TaskRef = TVar CallbackMap type LocalState = Map LocalRepoIndex LocalRepo type LocalStateRef = TVar LocalState -} mkLabels [ ''RepoState ]