Types.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}

module FP.API.Types (module FP.API.Types, module FP.API.Runner) where

import Data.Data
import Data.Text
import FFI
import FP.API.Runner
import Language.Fay.Yesod hiding (Text)
import Prelude

#ifndef FAY
import Control.Applicative
import Control.Exception.Lifted
import Control.Monad
import Control.Monad.Base
import Control.Monad.Logger
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Control
import Control.Monad.Trans.Resource
import Data.Aeson hiding (Result(..))
import Data.Foldable
import Data.Hashable
import Data.Serialize
import Data.Traversable
import Database.Persist.TH (derivePersistField)
import GHC.Generics (Generic)
#endif

data ProjectState = Workspaces | UserState
#ifdef FAY
    deriving (Read, Typeable, Data, Show, Eq)
#else
    deriving (Show, Eq, Read, Data, Typeable, Enum, Bounded, Ord, Generic)

instance ToJSON ProjectState
instance FromJSON ProjectState
instance Serialize ProjectState
instance Hashable ProjectState

derivePersistField "ProjectState"
#endif

type Returns' a = Returns (CanFail a)

data CanFail a = Success (Automatic a) | Failure Text
    deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
             , Foldable, Traversable, Generic
#endif
             )

#ifndef FAY
instance ToJSON a => ToJSON (CanFail a)
instance FromJSON a => FromJSON (CanFail a)

deriving instance Functor CanFail

instance Monad CanFail where
    return = Success
    Failure e >>= _ = Failure e
    Success m >>= f = f m

newtype CanFailT m a = CanFailT { runCanFailT :: m (CanFail a) }

type MonadFail m = MonadIO m

failure :: MonadFail m => Text -> m a
failure = liftIO . throwIO . RunnerException

mapCanFailT :: (m (CanFail a) -> n (CanFail b)) -> CanFailT m a -> CanFailT n b
mapCanFailT f = CanFailT . f . runCanFailT

eitherFail :: MonadFail m => m (Either Text a) -> m a
eitherFail = (either failure return =<<)

eitherToCanFail :: Show e => Either e a -> CanFail a
eitherToCanFail (Left e)  = Failure (pack (show e))
eitherToCanFail (Right a) = Success a

-- | Try the given action, returning a Failure if it throw a RunnerException,
--   otherwise returning Success or propagation any exceptions.
tryOrFail :: (MonadBaseControl IO m, MonadFail m) => m a -> m (CanFail a)
tryOrFail f = do
    eres <- try f
    case eres of
        Left (fromException -> Just (RunnerException e)) -> return $ Failure e
        Left e  -> liftIO $ throwIO e
        Right x -> return $ Success x

maybeFail :: MonadFail m => Text -> m (Maybe a) -> m a
maybeFail e act = do
    mx <- act
    case mx of
        Nothing -> failure e
        Just x  -> return x

instance Functor m => Functor (CanFailT m) where
    fmap f = mapCanFailT (fmap (fmap f))

instance Foldable f => Foldable (CanFailT f) where
    foldMap f (CanFailT a) = foldMap (foldMap f) a

instance Traversable f => Traversable (CanFailT f) where
    traverse f (CanFailT a) = CanFailT <$> traverse (traverse f) a

instance (Functor m, Monad m) => Applicative (CanFailT m) where
    pure = return
    (<*>) = ap

instance (Functor m, Monad m) => Alternative (CanFailT m) where
    empty = mzero
    (<|>) = mplus

instance Monad m => Monad (CanFailT m) where
    fail e = CanFailT (return (Failure (pack e)))
    return = lift . return
    x >>= f = CanFailT $ do
        v <- runCanFailT x
        case v of
            Failure e -> return $ Failure e
            Success y -> runCanFailT (f y)

instance Monad m => MonadPlus (CanFailT m) where
    mzero = CanFailT (return (Failure (pack "mzero")))
    mplus x y = CanFailT $ do
        v <- runCanFailT x
        case v of
            Failure _ -> runCanFailT y
            Success _ -> return v

-- instance MonadFix m => MonadFix (CanFailT m) where
--     mfix f = CanFailT (mfix (runCanFailT . f . unSuccess))
--       where unSuccess = fromCanFail (error "mfix CanFailT: Failure")

instance MonadTrans CanFailT where
    lift = CanFailT . liftM Success

instance MonadIO m => MonadIO (CanFailT m) where
    liftIO = lift . liftIO

instance MonadBase IO m => MonadBase IO (CanFailT m) where
    liftBase = lift . liftBase

instance MonadThrow m => MonadThrow (CanFailT m) where
    throwM = lift . throwM

#if MIN_VERSION_monad_control(1,0,0)
newtype StCFR m a = StCFR { unStCFR :: StM m (CanFail a) }
#endif
instance MonadBaseControl IO m => MonadBaseControl IO (CanFailT m) where
#if MIN_VERSION_monad_control(1,0,0)
  type StM (CanFailT m) a = StCFR m a
#else
  data StM (CanFailT m) a =
      StCFR { unStCFR :: StM m (CanFail a) }
#endif
  liftBaseWith f = CanFailT $ fmap Success $
      liftBaseWith $ \runInBase ->
          f (\(CanFailT sT) -> liftM StCFR . runInBase $ sT)
  restoreM = CanFailT . restoreM . unStCFR

instance MonadResource m => MonadResource (CanFailT m) where
    liftResourceT = lift . liftResourceT

instance MonadLogger m => MonadLogger (CanFailT m) where
    monadLoggerLog a b c d = lift $ monadLoggerLog a b c d
#endif

data RunnerProjectClosed = RunnerProjectClosed (Maybe SessionId)
    deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
              , Generic
#endif
             )
#ifndef FAY
instance Serialize RunnerProjectClosed
instance ToJSON RunnerProjectClosed
instance FromJSON RunnerProjectClosed
#endif

data GetProjectMessages
    = GetProjectMessages ProjectMessagesRequest
      (Returns' ProjectMessagesOutput)
    deriving (Read, Typeable, Data, Show, Eq)

data ProjectMessagesRequest
    = PMRFirstRequest
    | PMRLaterRequest Integer StatusHash MailboxId
    -- ^ The message sequence number and status hash we last got back.
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Generic
#endif
             )

#ifndef FAY
instance ToJSON ProjectMessagesRequest
instance FromJSON ProjectMessagesRequest
instance Serialize ProjectMessagesRequest
instance Hashable ProjectMessagesRequest
#endif

data IdeCommand
    -- Project global
    = GetInitialProjectInfo  Text
      (Returns' InitialProjectInfo)
    | ReparseProjectSettings
      (Returns' (Maybe RunnerProjectClosed))
    | SetSettings            SetSettingsInput
      (Returns' (Either CompileIdent RunnerProjectClosed))
    | SetPublic              Bool
      (Returns' ())
    | GetPublic
      (Returns' Bool)
    | SetProjectMetadata     Text Text
      (Returns' ())
    | SaveProjectState       ProjectState Text
      (Returns' ())
    | DeleteProject          Text
      (Returns' ())
    | ResetProjectSettings   Text
      (Returns' RunnerProjectClosed)
    | SdistTarball
      (Returns' (Either Text SdistTarballInfo))
    | RestartBackend Text
      (Returns' RunnerProjectClosed)
    | GenerateHaddocks
      (Returns' Text)
    | Ping
      (Returns' ())

    -- Files
    | AddFile                NewFileInfo
      (Returns' SaveFileOutput)
    | SaveFile               EncFileName Text FayTutorialToken
      (Returns' SaveFileOutput)
    | DeleteFile             EncFileName
      (Returns' (Maybe CompileDesc))
    | RenameFile             EncFileName NewFileInfo RenameType
      (Returns' RenameFileOutput)
    | GetFile                EncFileName
      (Returns' FayFileContent)
    | GetFileToken           EncFileName
      (Returns' FayTutorialToken)
    | GetAllFiles
      (Returns' [FileDesc])
    | SetModuleExclusion     EncFileName Bool
      (Returns' (Maybe CompileDesc))
    | ReformatModule         EncFileName
      (Returns' (Maybe CompileDesc))
    | RenderFileMarkdown     EncFileName
      (Returns' HtmlReply)

    -- Info
    | GetTypeInfo            SourceSpan
      (Returns' (Maybe TypeInfo))
    | GetTypeInfoDominators  SourceSpan
      (Returns' [TypeInfo])
    | GetFindUsages          SourceSpan
      (Returns' [SearchResult])
    | GetDefinitionSource    SourceSpan
      (Returns' IdInfo)
    | GetAutocompletions     AutoCompleteInput
      (Returns' [Text])
    | IdeHoogleSearch        (Maybe EncFileName) Bool Int Int Int Text
      (Returns' (Text, [HoogleResult], Maybe Int))
      -- ^ module context, is it exact?, number to query, offset in result,
      -- number to yield, query contents
    | SearchProject          SearchQuery Int Int Bool
      (Returns' [SearchResult])
    -- ^ query, offset, limit, case sensitive?

    -- Compilation
    | SetTarget              (Maybe (Either EncFileName RunConfigId))
      (Returns' (Maybe CompileDesc))
    | GetTarget
      (Returns' (Maybe (Either EncFileName RunConfigId)))
    | RunTarget Bool
      (Returns' ProcId)
      -- ^ True == run compiled code, False == run bytecode
    -- jww (2014-02-04): Make these use the current target.
    | CompileBinary          EncFileName [(Text, Text)]
      (Returns' UploadedBuild)
    -- ^ module to compile and extra files to include in tarball

    -- Git
    | GetGitHistory          Int Int
      (Returns' [GitHistoryItem])
    | IsProjectDirty
      (Returns' Bool)
    | SetRoot                Text Text
      (Returns' CompileDesc)
    | SetRemotes             RemotesList
      (Returns' ())

    | GetGitConfig           Text
      (Returns' Text)
    | SetGitConfig           Text Text
      (Returns' ())
    | GitCommit              Text
      (Returns' CommitSHA)      -- ^ Text == Log message
    | GitReset
      (Returns' RunnerProjectClosed)
    | GitPush                Text
      (Returns' GitPushResult) -- ^ Text == URL
    | GitPushIgnoreDirty     Text
      (Returns' ()) -- ^ Text == URL
    | GitPull                Text
      (Returns' GitPullResult) -- ^ Text == URL
    | GitMergeAbort
      (Returns' RunnerProjectClosed) -- ^ Text == URL
    | GitMergeDone           MaybeText
      (Returns' GitResolvedResult) -- ^ Text == URL, Msg
    | GitResolveFile         EncFileName
      (Returns' ())
    | GitDiff
      (Returns' Text)

    -- Git Bash
    | StartGitShell
      (Returns' GitShellId)
    | GitShellInput GitShellId Text
      (Returns' ())
    | ApplyGitShell GitShellId
      (Returns' RunnerProjectClosed)
    | CancelGitShell GitShellId
      (Returns' ())

    | CreateBranch           BranchName CommitName
      (Returns' ())
    | DeleteBranch           BranchName
      (Returns' ())
    | CheckoutBranch         BranchName
      (Returns' GitCheckoutResult)

    -- Refactorings
    | RenameRefactoring      SourceSpan Text RefactoringContext
      (Returns' RefactoringOutput)
    | ExtractRefactoring     SourceSpan Text RefactoringContext
      (Returns' RefactoringOutput)

    -- Deployment
    | GetKeterYaml           FayDeploymentId ModuleName
      (Returns' KeterYaml)
    | SetRunConfigs          [(RunConfigId, RunConfig)]
      (Returns' ())
    | SetDeployments         [(FayDeploymentId, Deployment)]
      (Returns' ())
    | GetNewRunConfig
      (Returns' NewRunConfig)
    | GetNewDeployment
      (Returns' NewDeployment)
    | GetNewWebApp           FayDeploymentId
      (Returns' NewWebApp)
    | GetNewBgJob            FayDeploymentId
      (Returns' NewBgJob)

    | CheckHostName          Text
      (Returns' UseHostName)
    | GetRandomHostName
      (Returns' RandomHostName)
    | GetDeploymentManagerInfo
      (Returns' DeploymentManagerInfo)

    -- Processes (shared by the IDE and School of Haskell)
    | PutStdin ProcId Text
      (Returns' Bool) -- ^ Bool == whether the stdin was successfully delivered
    | StopRunningCode
      (Returns' ())

    -- School of Haskell commands (using project id 0)
    | StartInteractive [FileToRun]
      (Returns' (ErrorsAnd ProcId))
      -- ^ Text == GHC environment, Just result gives a failure
    | StartInteractiveWeb [FileToRun]
      (Returns' (ErrorsAnd ApprootPid))
    | HoogleSearch Bool Text Text
      (Returns' FayHoogleResults)
      -- ^ Bool == is it an exact search?, module source code for import
      -- statement, query
    | GetConflictingPackages
      (Returns' [[(Bool,Text)]])
    deriving (Read, Typeable, Data, Show, Eq)

data FayCommand
    -- Github
    = UserAuthedGithub
      (Returns' Bool)
    | RevokeGithub
      (Returns' ())
    | GetGithubUrl Text
      (Returns' Text)
    | SshPublicKey
      (Returns' Text)

    -- Configuration
    | GenerateConfiguration
      (Returns' ())

    -- Soh
    | GetIFilesFromCode Text Text (Maybe Text)
      (Returns' IFiles) -- ^ title, code, environment
    | GetIFilesFromURL Text
      (Returns' IFiles)

    -- Misc
    | SaveProfile Theme Int Bool
      (Returns' ())
    | GetProjectId Text
      (Returns' ProjectId)
    | CloseAllProjects
      (Returns' ())
    | SetSettingsSubstitutions Text
      (Returns' ())
    | GetSettingsSubstitutions
      (Returns' Text)

    -- Announcements
    | SeenAnnouncement Text
      (Returns' ())
    | GetAnnouncements
      (Returns' [(Text,Text,Text)])

    deriving (Read, Typeable, Data, Show)

-- | Values passed to the client when initially loading the IDE.
data InitialProjectInfo = InitialProjectInfo
    { ipiTitle           :: Text
    , ipiDesc            :: Text
    , ipiGitUrl          :: Maybe Text -- ^ URL originally cloned from
    , ipiMergeConflicts  :: Maybe [MergeConflict]
    , ipiState           :: [(ProjectState, Text)]
    , ipiFiles           :: [FileDesc]
    , ipiTarget          :: Maybe (Either EncFileName RunConfigId)
    , ipiPublished       :: Bool
    , ipiBranches        :: BranchesList
    , ipiRemotes         :: RemotesList
    , ipiRunConfigs      :: [(RunConfigId, RunConfig)]
    , ipiDeployments     :: [(FayDeploymentId, Deployment)]
    , ipiTheme           :: Theme
    , ipiFontSize        :: Int
    , ipiSearchWithRegex :: Bool
    , ipiLicense         :: IdeLicense
    , ipiCanPublish      :: Bool
    , ipiSettings        :: Maybe ProjectSettings
    }
    deriving (Read, Typeable, Data, Show, Eq)

data IFiles = IFiles
    { ifilesFiles    :: [IFile]
    , ifilesCloneUrl :: Text
    }
    deriving (Read, Typeable, Data, Show, Eq)

data IFile = IFile
    { ifileName :: Text
    , ifileContent :: IFileContents
    }
    deriving (Read, Typeable, Data, Show, Eq)

data Base64 = Base64 Text
    deriving (Read, Typeable, Data, Show, Eq)

data IFileContents = IFCText [IFileContent] | IFCBase64 Base64
    deriving (Read, Typeable, Data, Show, Eq)

data IFileContent = IFCStatic Text
                  | IFCEditable Editable
    deriving (Read, Typeable, Data, Show, Eq)


data Editable = Editable
    { editableTitle :: Maybe Text
    , editableContent :: Text
    , editableMarks :: [SrcSpan]
    }
    deriving (Read, Typeable, Data, Show, Eq)

data SrcSpan = SrcSpan SrcLoc SrcLoc
    deriving (Read, Typeable, Data, Show, Eq)

data SrcLoc = SrcLoc
    { srcLocLine    :: Int
    , srcLocColumn  :: Int
    }
    deriving (Read, Typeable, Data, Show, Eq)

data StdoutResult = SRSuccess Text
                  | SRTerminated ProcessResult
    deriving (Read, Typeable, Data, Show, Eq)

data FileToRun = FileToRun
    { ftrName :: Text
    , ftrContent :: FTRContent
    }
    deriving (Read, Typeable, Data, Show, Eq)

data FTRContent = FTRCText Text | FTRCBinary Base64
    deriving (Read, Typeable, Data, Show, Eq)

data FayHoogleResults = FayHoogleBadQuery Text
                      | FayHoogleResults Text [HoogleResult] (Maybe Int) -- ^ Text == HTML version of query, Int == total count
    deriving (Read, Typeable, Data, Show, Eq)

data IdeLicense = ILCommunity | ILPersonal | ILProfessional
    deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
              , Generic
#endif
             )
#ifndef FAY
instance Serialize IdeLicense
instance ToJSON IdeLicense
instance FromJSON IdeLicense
#endif

data MaybeText = NoText | JustText Text -- FAY BUG
    deriving (Read, Typeable, Data, Show, Eq)

-- | Result of checking out a branch (or ref, in future).
data GitCheckoutResult = GCRDirty
                       | GCROk (Maybe RunnerProjectClosed)
    deriving (Read, Typeable, Data, Show, Eq)

data GitPullResult = GPRSuccess RunnerProjectClosed
                   | GPRDirtyTree
                   | GPRManualMerge Text RunnerProjectClosed
    deriving (Read, Typeable, Data, Show, Eq)

data GitPushResult = GURSuccess | GURDirtyTree
    deriving (Read, Typeable, Data, Show, Eq)

data GitResolvedResult = GRRSuccess
                       | GRRStillUnresolved [MergeConflict]
    deriving (Read, Typeable, Data, Show, Eq)

data MergeConflict = MergeConflict
    { mergeFile :: EncFileName
    , mergeState :: MergeModifyPair
    }
    deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
              , Generic
#endif
             )
#ifndef FAY
instance Serialize MergeConflict
instance ToJSON MergeConflict
instance FromJSON MergeConflict
#endif

data RemotesList = RemotesList [(Text, Text)]
    deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
             , Generic
#endif
             )
#ifndef FAY
instance Serialize RemotesList
instance ToJSON RemotesList
instance FromJSON RemotesList
#endif

data BranchesList = BranchesList BranchName [BranchName]
    deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
             , Generic
#endif
             )
#ifndef FAY
instance Serialize BranchesList
instance ToJSON BranchesList
instance FromJSON BranchesList
#endif

data ProjectSettings = ProjectSettings
    { psModuleTemplate :: Text
    , psExtensions     :: [(Text, Maybe Bool)] -- ^ three states: on, off, or default (== Nothing)
    , psEnvironment    :: Environment
    , psEnvironments   :: [Environment]
    , psGhcArgs        :: [Text]
    , psBinaryGhcArgs  :: [Text]
    , psExtraPackages  :: Text
    , psAutoHidden     :: [[(Bool,Text)]]
    , psCabalName      :: Text
    , psCabalVersion   :: Text
    , psRoot           :: Text
    , psFilters        :: Text
    }
    deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
              , Generic
#endif
             )
#ifndef FAY
instance Serialize ProjectSettings
instance ToJSON ProjectSettings
instance FromJSON ProjectSettings
#endif

data SetExtension = SetExtension Text Bool
    deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
              , Generic
#endif
             )
#ifndef FAY
instance Serialize SetExtension
instance ToJSON SetExtension
instance FromJSON SetExtension
#endif

data SetSettingsInput = SetSettingsInput
    { ssiModuleTemplate :: Text
    , ssiExtensions     :: [SetExtension]
    , ssiEnvironment    :: Text
    , ssiGhcArgs        :: [Text]
    , ssiBinaryGhcArgs  :: [Text]
    , ssiExtraPackages  :: Text
    , ssiAutohidden     :: [[(Bool,Text)]]
    , ssiCabalName      :: Text
    , ssiCabalVersion   :: Text
    }
    deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
              , Generic
#endif
             )
#ifndef FAY
instance Serialize SetSettingsInput
instance ToJSON SetSettingsInput
instance FromJSON SetSettingsInput
#endif

-- | A GHC environment.
data Environment = Environment
  { envName :: Text
  , envTitle :: Text
  , envURL :: Text
  , envDetailedId :: Text
  }
  deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
           , Generic
#endif
           )
#ifndef FAY
instance Serialize Environment
instance ToJSON Environment
instance FromJSON Environment
#endif

data RunGhciOutput = RunGhciOutput ProcId ProjectId
    deriving (Read, Typeable, Data, Show, Eq)

data TopLevelIdentifiers = TopLevelIdentifiers [TopLevelIdentifier]
    deriving (Read, Typeable, Data, Show, Eq)

data TopLevelIdentifier = TopLevelIdentifier
    { tliLine :: Int
    , tliColumn :: Int
    , tliName :: Text
    }
    deriving (Read, Typeable, Data, Show, Eq)

data RefactoringContext
    = PortionContext SourceSpan Text
    | ModuleContext ModuleName
    deriving (Read, Typeable, Data, Show, Eq)

data RefactoringOutput
    = PortionOutput Text
    | ModuleOutput Text
    deriving (Read, Typeable, Data, Show, Eq)

-- | A simple text reply.
data TextReply
  = TextReply { unTextReply :: Text }
  deriving (Read, Typeable, Data, Show, Eq)

-- | An html reply.
data HtmlReply
  = HtmlReply { unHtmlReply :: Text }
  deriving (Read, Typeable, Data, Show, Eq)

-- | A run configuration for a project.
data RunConfig = RunConfig
  { rcTitle :: Text
  , rcMainFile :: Maybe EncFileName
  , rcArgs :: [Text]
  , rcEnv :: [(Text, Text)]
  } deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )
#ifndef FAY
instance ToJSON RunConfig
instance FromJSON RunConfig
instance Serialize RunConfig
instance Hashable RunConfig
#endif

-- | Make a new run configuration.
data NewRunConfig = NewRunConfig (RunConfigId, RunConfig)
  deriving (Read, Typeable, Data, Show, Eq)

-- | A deployment configuration.
data Deployment = Deployment
  { depTitle :: Text
  , depStanzas :: [Stanza]
  } deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
             , Generic
#endif
             )
#ifndef FAY
instance Serialize Deployment
instance ToJSON Deployment
instance FromJSON Deployment
#endif

-- | Possible stanza types.
data Stanza = WebAppStanza FayWebAppId WebApp
            | BgJobStanza FayBgJobId BgJob
  deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
           , Generic
#endif
           )
#ifndef FAY
instance Serialize Stanza
instance ToJSON Stanza
instance FromJSON Stanza
#endif

data NewDeployment = NewDeployment (FayDeploymentId, Deployment)
  deriving (Read, Typeable, Data, Show, Eq)

-- | A web app stanza.
data WebApp = WebApp
  { wapTitle    :: Text
  , wapHostname :: Maybe Text
  , wapFileName :: Maybe EncFileName
  , wapArgs     :: [Text]
  , wapEnv      :: [(Text, Text)]
  , wapSsl      :: Bool
  } deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
             , Generic
#endif
             )
#ifndef FAY
instance Serialize WebApp
instance ToJSON WebApp
instance FromJSON WebApp
#endif

data NewWebApp = NewWebApp (FayWebAppId, WebApp)
  deriving (Read, Typeable, Data, Show, Eq)

-- | A background job stanza.
data BgJob = BgJob
  { bgTitle        :: Text
  , bgFileName     :: Maybe EncFileName
  , bgArgs         :: [Text]
  , bgEnv          :: [(Text, Text)]
  , bgRestartLimit :: Maybe Int
  , bgRestartDelay :: Int
  } deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
             , Generic
#endif
             )
#ifndef FAY
instance Serialize BgJob
instance ToJSON BgJob
instance FromJSON BgJob
#endif

-- | Make a new background job.
data NewBgJob = NewBgJob (FayBgJobId, BgJob)
  deriving (Read, Typeable, Data, Show, Eq)

-- | Result of trying to use a hostname.
data UseHostName = HostnameInUse         -- ^ Host name is in use by someone else, can't be used.
                 | HostnameOK            -- ^ Host name was already or has now been registered and is now in use.
                 | HostnameQuotaExcess   -- ^ Couldn't register the hostname due to quota.
                 | HostnameInvalid       -- ^ Invalid hostname.
  deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
           , Generic
#endif
           )
#ifndef FAY
instance Serialize UseHostName
instance ToJSON UseHostName
instance FromJSON UseHostName
#endif

-- | Yaml text for a Keter config.
data KeterYaml = KeterYaml
    { keterYaml :: Text
    , deployYaml :: Text
    }
  deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
           , Generic
#endif
           )
#ifndef FAY
instance Serialize KeterYaml
instance ToJSON KeterYaml
instance FromJSON KeterYaml
#endif

-- | A randomly generated host name.
data RandomHostName = RandomHostName { unRandomHostname :: Text }
  deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
           , Generic
#endif
           )
#ifndef FAY
instance Serialize RandomHostName
instance ToJSON RandomHostName
instance FromJSON RandomHostName
#endif

-- | A date of expiration, if any.
data ExpiryTime = ExpiryTime (Maybe Integer)
  deriving (Read, Typeable, Data, Show, Eq)

data DeploymentManagerInfo = DeploymentManagerInfo
  { dmiHostname :: Text }
  deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
           , Generic
#endif
           )
#ifndef FAY
instance Serialize DeploymentManagerInfo
instance ToJSON DeploymentManagerInfo
instance FromJSON DeploymentManagerInfo
#endif

data FayDeploymentId = FayDeploymentId { unFayDeploymentId :: Text }
    deriving (Read, Typeable, Data, Show, Eq)

data FayBgJobId = FayBgJobId { unFayBgJobId :: Text }
    deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
             , Generic
#endif
             )
#ifndef FAY
instance Serialize FayBgJobId
instance ToJSON FayBgJobId
instance FromJSON FayBgJobId
#endif

data FayWebAppId = FayWebAppId { unFayWebAppId :: Text }
    deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
             , Generic
#endif
             )
#ifndef FAY
instance Serialize FayWebAppId
instance ToJSON FayWebAppId
instance FromJSON FayWebAppId
#endif

--------------------------------------------------------------------------------
-- Themes

-- | Themes supported by the IDE.
data Theme = Panda | Zenburn | Monokai
#ifdef FAY
  deriving (Read, Typeable, Data, Show, Eq)
#else
  deriving (Show, Eq, Read, Data, Typeable, Bounded, Enum)
#endif

--------------------------------------------------------------------------------
-- Search

data SearchQuery
  = SearchQueryRegex Text
  | SearchQueryPlain Text
  deriving (Read, Typeable, Data, Show, Eq)