module FP.Server.Types where
import FP.API.Run
import FP.API.Types
import FP.Server.Config
import Control.Concurrent (MVar)
import Control.Monad.Logger (LoggingT)
import Control.Monad.Reader
import Data.Aeson
import Data.Default
import Data.Map (Map)
import Data.Maybe
import Data.Text as T
import GHC.Generics
type Server = LoggingT (ReaderT ServerReader IO)
data ServerReader = ServerReader
{ serverCC :: ClientConfig
, serverConfig :: Config
, serverPollers :: MVar (Map FayProjectId [Callback])
, serverTokens :: MVar (MVar (Map FilePath FayTutorialToken))
}
newtype Callback = Callback (Maybe Int -> RunnerMessage -> Server Done)
data Done = NotDone | Done
deriving Eq
deriving instance Ord FayProjectId
instance MonadClient Server where
getClientConfig = asks serverCC
data Config = Config
{ configToken :: !Text
, configUrl :: !Text
, configPort :: !Integer
, configAgent :: !Text
, configDebug :: !Bool
, configStartServer :: !Bool
} deriving (Show)
instance Default Config where
def = Config "" defaultUrl defaultPort "fpco-api" True False
data Msg = MsgSaveModule FayProjectId FilePath FilePath
| MsgCheckModule FayProjectId FilePath FilePath FilePath
| MsgTypeInfo FayProjectId FilePath Int Int Int Int
| MsgGetDefinition FayProjectId FilePath FilePath Int Int Int Int
| MsgAutoComplete FayProjectId FilePath Text
| MsgHoogleIdent FayProjectId FilePath Text
| MsgHoogleDb FayProjectId Text
| MsgDownloadFiles (Either Text FayProjectId) FilePath
| MsgWriteEmacsConfig (Either Text FayProjectId) FilePath
deriving (Generic,Show)
instance FromJSON Msg
instance ToJSON Msg
data Reply = ReplyPong ()
| ReplyOK ()
| ReplyCompileMessages [CompileMessage]
| ReplyCompileInfos [SourceInfo]
| ReplyTypeInfo [SpanType]
| ReplyLocation DefinitionLoc
| ReplyCompletions [Text]
| ReplyHoogleResults [HoogleResult]
| ReplyHoogleResult HoogleResult
| ReplySaveStatus Bool
deriving (Generic,Show)
instance ToJSON Reply
instance FromJSON Reply
data DefinitionLoc = DefinitionLoc Loc
| DefinitionUseless Text
| DefinitionImport Text
ModuleId
ModuleId
(Maybe Loc)
(Maybe Loc)
deriving (Generic,Show)
instance ToJSON DefinitionLoc
instance FromJSON DefinitionLoc
data ModuleId = ModuleId Text Text
deriving (Generic,Show)
instance ToJSON ModuleId
instance FromJSON ModuleId
data Loc = Loc FilePath Int Int Int Int
deriving (Generic,Show)
instance ToJSON Loc
instance FromJSON Loc
data SpanType = SpanType Int Int Int Int
Text
Text
deriving (Generic,Show)
instance ToJSON SpanType
instance FromJSON SpanType
data CompileMessage
= CompileMessage Text Text Text
deriving (Show,Generic)
instance ToJSON CompileMessage
instance FromJSON CompileMessage
instance FromJSON FayProjectId where
parseJSON v = fmap (FayProjectId . T.pack . (show :: Int -> String))
(parseJSON v)
instance ToJSON FayProjectId where
toJSON (FayProjectId i) =
toJSON ((fromMaybe (error ("Unable to read: " ++ show i)) .
fmap fst .
listToMaybe)
(reads (T.unpack i) :: [(Int,String)]))
deriving instance Generic SourceInfo
instance ToJSON SourceInfo
instance FromJSON SourceInfo
deriving instance Generic SourceInfoKind
instance ToJSON SourceInfoKind
instance FromJSON SourceInfoKind
deriving instance Generic EitherSpan
instance ToJSON EitherSpan
instance FromJSON EitherSpan
deriving instance Generic SourceSpan
instance ToJSON SourceSpan
instance FromJSON SourceSpan
deriving instance Generic FayFileName
instance ToJSON FayFileName
instance FromJSON FayFileName
deriving instance Generic FayModuleName
instance ToJSON FayModuleName
instance FromJSON FayModuleName
deriving instance Generic HoogleResult
instance ToJSON HoogleResult
instance FromJSON HoogleResult
deriving instance Generic PackageLink
instance ToJSON PackageLink
instance FromJSON PackageLink
deriving instance Generic ModuleLink
instance ToJSON ModuleLink
instance FromJSON ModuleLink