{-# LANGUAGE CPP #-}
#ifdef FAY
{-# LANGUAGE NoImplicitPrelude #-}
#endif
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module FP.API.Runner where

#ifdef FAY

import           Data.Data
import           Data.Text
import           FFI
import           Prelude

#else

import           Control.Applicative
import           Control.DeepSeq (NFData(..))
import           Control.DeepSeq.Generics (genericRnf)
import           Control.Exception.Lifted
import           Control.Monad
import           Data.Aeson
import           Data.ByteString hiding (map)
import qualified Data.ByteString.Base64 as B64
import           Data.Data
import           Data.Default
import           Data.Hashable
import qualified Data.Map as M
import           Data.Ratio
import           Data.Semigroup
import           Data.Serialize
import           Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import           Data.Text.Encoding.Error (lenientDecode)
import           Data.Time
import           Database.Persist.Sql (PersistField, PersistFieldSql, sqlType)
import           Database.Persist.TH (derivePersistField)
import           FFI
import           GHC.Generics (Generic)
import           Prelude
import           System.Random (Random)
import           Text.Blaze.Html (ToMarkup)
import           Text.Shakespeare.I18N (ToMessage)
import           Yesod.Core.Dispatch (PathPiece)

data RunnerException = RunnerException Text
    deriving (Eq, Typeable)

instance Show RunnerException where
#ifndef FAY
     show (RunnerException err) = T.unpack err
#endif

instance Exception RunnerException

fromString :: String -> Text
fromString = T.pack

toString :: Text -> String
toString = T.unpack

decodeBytes :: ByteString -> Text
decodeBytes = T.decodeUtf8With lenientDecode

encodeBytes :: Text -> ByteString
encodeBytes = T.encodeUtf8

#endif

data Filters = Filters
  { filtersRoot :: Text
  , filtersBlacklist :: [Text]
  }
#ifndef FAY
  deriving (Eq,Read,Show,Typeable,Data,Ord,Generic)
#else
  deriving (Eq,Read,Show,Typeable,Data)
#endif

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

#ifndef FAY

-- | The standard ByteString instances in aeson are broken: they assume UTF8
--   encoding. This type instead uses base64 for proper round-tripping.
newtype ByteString64 = ByteString64 { unByteString64 :: ByteString }
    deriving (Eq, Read, Show, Data, Typeable, Ord,
              Serialize, Generic, Hashable)
instance ToJSON ByteString64 where
    toJSON (ByteString64 bs) = toJSON (T.decodeUtf8 $ B64.encode bs)
instance FromJSON ByteString64 where
    parseJSON o =
        parseJSON o >>= either fail (return . ByteString64) . B64.decode . T.encodeUtf8

newtype WrappedUTCTime = WrappedUTCTime { unWrappedUTCTime :: UTCTime }
    deriving (Eq, Read, Show, Data, Typeable, Ord,
              Serialize, Generic, Hashable)

toPicoSeconds :: UTCTime -> Integer
toPicoSeconds t = numerator x
  where
    x     = toRational day * 86400 * pico + psecs * pico
    day   = toModifiedJulianDay (utctDay t)
    psecs = toRational (utctDayTime t)
    pico  = 10^(12 :: Integer)

fromPicoSeconds :: Integer -> UTCTime
fromPicoSeconds x = UTCTime (ModifiedJulianDay dayPart) (fromRational psecs)
  where
    dayPart = x `div` day
    day     = 86400 * pico
    psecs   = (x - dayPart * day) % pico
    pico    = 10^(12 :: Integer)

instance Serialize UTCTime where
    put = put . toPicoSeconds
    get = fmap fromPicoSeconds get

instance Hashable UTCTime where
    hash t = hash (toPicoSeconds t)
    hashWithSalt x t = hashWithSalt x (toPicoSeconds t)

instance ToJSON WrappedUTCTime where
    toJSON (WrappedUTCTime t) = toJSON (toPicoSeconds t)
instance FromJSON WrappedUTCTime where
    parseJSON o = WrappedUTCTime . fromPicoSeconds <$> parseJSON o

#endif

newtype ProjectId = ProjectId { unProjectId :: Int }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Num, Enum, Bounded, Real, Integral, Ord,
              PathPiece, ToJSON, FromJSON,
              Serialize, Generic, Hashable
#endif
             )

unProjectIdString :: ProjectId -> String
unProjectIdString = show . unProjectId

unProjectIdText :: ProjectId -> Text
unProjectIdText = fromString . unProjectIdString

newtype RunConfigId = RunConfigId { unRunConfigId :: Int }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Num, Enum, Bounded, Real, Integral, Ord,
              PathPiece, ToJSON, FromJSON,
              Serialize, Generic, Hashable, NFData
#endif
             )

newtype JobId = JobId { unJobId :: Int }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Num, Enum, Bounded, Real, Integral, Ord,
              PathPiece, ToJSON, FromJSON,
              Serialize, Generic, Hashable, NFData
#endif
             )

newtype CompileId = CompileId { unCompileId :: Int }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Num, Enum, Bounded, Real, Integral, Ord,
              PathPiece, ToJSON, FromJSON,
              Serialize, Generic, Hashable, NFData
#endif
             )

newtype ProcId = ProcId { unProcId :: Int }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Num, Enum, Bounded, Real, Integral, Ord,
              PathPiece, ToJSON, FromJSON,
              Serialize, Generic, Hashable, NFData
#endif
             )

newtype GitShellId = GitShellId { unGitShellId :: Int }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Num, Enum, Bounded, Real, Integral, Ord,
              PathPiece, ToJSON, FromJSON,
              Serialize, Generic, Hashable, NFData
#endif
             )

#ifndef FAY
instance Serialize Text where
    put = put . T.encodeUtf8
    get = fmap T.decodeUtf8 get
#endif

newtype FormattedTime = FormattedTime { unFormattedTime :: Text }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, PathPiece, ToJSON, FromJSON,
              Serialize, Generic, Hashable, NFData
#endif
             )

newtype ModuleName = ModuleName { unModuleName :: Text }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, PathPiece, ToJSON, FromJSON,
              Serialize, Generic, Hashable, NFData
#endif
             )

moduleNameString :: ModuleName -> String
moduleNameString = toString . unModuleName

data ModuleStatus
    = WrongExtension
    | NotTextual
    | CFile
    | BootFile ModuleName
    | HeaderFilenameMismatch ModuleName
    | ModuleOk ModuleName
      -- ^ This can also be valid for data files, if the user has manually
      --   excluded them.
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )
#ifndef FAY
instance ToJSON ModuleStatus
instance FromJSON ModuleStatus
instance Serialize ModuleStatus
instance Hashable ModuleStatus
#endif

#ifndef FAY
newtype FileName
    = FileName { unFileName :: ByteString }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
             , Ord, Generic, Serialize, Hashable
#endif
             )

instance ToJSON FileName where
    toJSON (FileName bs) = toJSON (T.decodeUtf8 $ B64.encode bs)
instance FromJSON FileName where
    parseJSON o =
        parseJSON o >>= either fail (return . FileName) . B64.decode . T.encodeUtf8

unFileNameText :: FileName -> Text
unFileNameText = decodeBytes . unFileName

unFileNameString :: FileName -> String
unFileNameString = toString . unFileNameText

fileNameFromText :: Text -> FileName
fileNameFromText = FileName . encodeBytes

fileNameFromString :: String -> FileName
fileNameFromString = FileName . encodeBytes . fromString
#endif

data EncFileName
    = EncFileNameText { unEncFileNameText :: Text }
    | EncFileNameBase64 { unEncFileNameText :: Text, encFileNameBase64 :: Text }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )

#ifndef FAY
instance ToJSON EncFileName
instance FromJSON EncFileName
instance Serialize EncFileName
instance Hashable EncFileName
instance NFData EncFileName where rnf = genericRnf

encodeBase64FileName :: FileName -> Text
encodeBase64FileName (FileName bs) = T.decodeUtf8 $ B64.encode bs

decodeBase64FileName :: Text -> FileName
decodeBase64FileName = FileName . B64.decodeLenient . T.encodeUtf8

encFileName :: FileName -> EncFileName
encFileName = encFileNameFromByteString . unFileName

unEncFileName :: EncFileName -> FileName
unEncFileName (EncFileNameBase64 _ bs64) = decodeBase64FileName bs64
unEncFileName (EncFileNameText txt) = FileName (T.encodeUtf8 txt)

encFileNameFromByteString :: ByteString -> EncFileName
encFileNameFromByteString bs =
    case T.decodeUtf8' bs of
        Left _ -> EncFileNameBase64 (decodeBytes bs) (decodeBytes (B64.encode bs))
        Right txt -> EncFileNameText txt
#endif

encFileNameFromText :: Text -> EncFileName
encFileNameFromText = EncFileNameText

encFileNameFromString :: String -> EncFileName
encFileNameFromString = encFileNameFromText . fromString

unEncFileNameString :: EncFileName -> String
unEncFileNameString = toString . unEncFileNameText

data FileType = SourceFile | DataFile
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Enum, Bounded, Ord, Generic
#endif
             )
#ifndef FAY
instance ToJSON FileType
instance FromJSON FileType
instance Serialize FileType
instance Hashable FileType
#endif

data FileDesc = FileDesc
    { fdEncFileName    :: EncFileName
    , fdModuleStatus   :: ModuleStatus
    , fdUserExcluded   :: Bool
    , fdFileType       :: FileType
    }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )

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

-- | When a file in the project representation is changed by a 'ProjectUpdate'
--   request, it often results in a change reflected in what we know about the
--   file.  This change is reported in the 'UpdateActions' structure using
--   this 'FileUpdate' type.
data FileUpdate = FileUpdated FileDesc | FileRemoved Bool
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )
#ifndef FAY
instance ToJSON FileUpdate
instance FromJSON FileUpdate
instance Serialize FileUpdate
instance Hashable FileUpdate
#endif

-- | A project's target is a single module containing a function named 'main'.
--   This type reflects if any change in the current target has been made.
data TargetUpdate = TargetSet EncFileName | TargetCleared
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )
#ifndef FAY
instance ToJSON TargetUpdate
instance FromJSON TargetUpdate
instance Serialize TargetUpdate
instance Hashable TargetUpdate
#endif

-- | After a 'ProjectUpdate' request is processed, a set of 'UpdateActions'
--   will result to reflect what changes have been made to the project
--   representation (and subsequently, what changes may need to be reflected
--   in the ide-backend, the database, and other caches).
data UpdateActions = UpdateActions
    { _uaUpdates   :: [(EncFileName, FileUpdate)]
    , _uaNewTarget :: Maybe TargetUpdate
    }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )

#ifndef FAY
instance ToJSON UpdateActions where
    toJSON (UpdateActions upds newt) =
        object [ "_uaUpdates"   .= toJSON upds
               , "_uaNewTarget" .= toJSON newt
               ]
instance FromJSON UpdateActions where
    parseJSON (Object v) = UpdateActions
        <$> v .: "_uaUpdates"
        <*> v .: "_uaNewTarget"
    parseJSON _ = error "Failed to read UpdateActions from JSON"

instance Serialize UpdateActions

instance Hashable UpdateActions where
    hash (UpdateActions upds newt) = hash upds `hashWithSalt` newt
    hashWithSalt x (UpdateActions upds newt) =
        hashWithSalt x upds `hashWithSalt` newt

instance Semigroup UpdateActions where
    UpdateActions bus1 fus1 <> UpdateActions bus2 fus2 =
        UpdateActions (M.toList (M.fromList bus2 <> M.fromList bus1))
            (fus2 `mplus` fus1)

instance Monoid UpdateActions where
    mempty  = UpdateActions mempty Nothing
    mappend = (<>)
#endif

-- | Describe a compilation which has been accepted by the isolation-runner.
--   This includes sufficient information to tell what is "in" the
--   compilation, and to distinguish it from any other compilation.
data CompileDesc = CompileDesc
    { cdCompileIdent  :: CompileIdent
    , cdUpdateActions :: UpdateActions
    , cdFilters       :: Maybe Filters
    }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Generic
#endif
             )

#ifndef FAY
instance ToJSON CompileDesc
instance FromJSON CompileDesc
instance Serialize CompileDesc
instance Hashable CompileDesc

instance Semigroup CompileDesc where
    CompileDesc _ upds1 root1 <> CompileDesc cid2 upds2 root2 =
        CompileDesc cid2 (upds1 <> upds2) (root1 <|> root2)
#endif

-- | Identifies a compilation, by combining a 'SessionId' with a 'CompileId'.
data CompileIdent = CompileIdent
    { ciSession :: SessionId
    , ciCompile :: CompileId
    }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Generic
#endif
             )

#ifndef FAY
instance ToJSON CompileIdent
instance FromJSON CompileIdent
instance Serialize CompileIdent
instance Hashable CompileIdent
instance NFData CompileIdent where rnf = genericRnf
#endif

-- | Backend session ID.
newtype SessionId = SessionId Text
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Generic, NFData
#endif
             )

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

newtype MailboxId = MailboxId Text
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Generic, NFData
#endif
             )

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

--------------------------------------------------------------------------------
-- Files / Modules

data NewFileInfo = NewFileInfo
    { fiPath   :: Text
    , fiModule :: Maybe ModuleName
    }
    deriving (Read, Typeable, Data, Show, Eq)

data RenameType = RenamePlain
                | RenameHeader
                | RenameHeaderAndImports
                | RenameHeaderAndImportsForce
    deriving (Read, Typeable, Data, Show, Eq)

data RenameFileOutput
    = RenameFileOutput (Maybe FayTutorialToken) (Maybe Text) (Maybe CompileDesc)
    | WarnImportRenaming [EncFileName]
    deriving (Read, Typeable, Data, Show, Eq)

data SaveFileOutput = SaveFileOutput FayTutorialToken (Maybe CompileDesc)
    deriving (Read, Typeable, Data, Show, Eq)

data FayFileContent = FayFileContent
    { dfcContent :: Maybe Text
    , dfcToken   :: FayTutorialToken
    }
    deriving (Read, Typeable, Data, Show, Eq)

--------------------------------------------------------------------------------
-- Version token

-- | A token for the tutorial.
type FayTutorialToken = TutorialConcurrentToken

#ifdef FAY
data TutorialConcurrentToken = TutorialConcurrentToken'
    { unTutorialConcurrentToken :: Int }
    deriving (Eq, Show, Data, Read, Typeable)
#else
-- | Token for a tutorial.
newtype TutorialConcurrentToken = TutorialConcurrentToken'
    { unTutorialConcurrentToken :: Int }
    deriving (Eq, Show, Data, Read, Typeable, Num, Ord, Generic,
              ToJSON, FromJSON, Serialize, Hashable,
              PersistField, Random)

instance Default TutorialConcurrentToken where
    def = TutorialConcurrentToken' 1

instance PersistFieldSql TutorialConcurrentToken where
    sqlType = sqlType . liftM unTutorialConcurrentToken

incrToken :: TutorialConcurrentToken -> TutorialConcurrentToken
incrToken (TutorialConcurrentToken' x) = TutorialConcurrentToken' (x + 1)
#endif

--------------------------------------------------------------------------------
-- Isolation-runner ids

data TypeInfo = TypeInfo SourceSpan Text [Text]
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )

#ifndef FAY
instance ToJSON TypeInfo
instance FromJSON TypeInfo
instance Serialize TypeInfo
instance Hashable TypeInfo
instance NFData TypeInfo where rnf = genericRnf
#endif

-- Copied from ide-backend/Common.hs
--  + Different deriving list
--  + 'Show' instances made into functions

data SourceSpan = SourceSpan
  { spanFilePath   :: EncFileName
  , spanFromLine   :: Int
  , spanFromColumn :: Int
  , spanToLine     :: Int
  , spanToColumn   :: Int }
  deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
           , Ord, Generic
#endif
           )

#ifndef FAY
instance ToJSON SourceSpan
instance FromJSON SourceSpan
instance Serialize SourceSpan
instance Hashable SourceSpan
instance NFData SourceSpan where rnf = genericRnf
#endif

data EitherSpan =
    ProperSpan SourceSpan
  | TextSpan Text
  deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
           , Ord, Generic
#endif
           )

#ifndef FAY
instance ToJSON EitherSpan
instance FromJSON EitherSpan
instance Serialize EitherSpan
instance Hashable EitherSpan
instance NFData EitherSpan where rnf = genericRnf
#endif

--------------------------------------------------------------------------------
-- Isolation-runner messages

-- | The timing separation between 'JobStillRunning' messages.  Note
-- that the actual interval will always be larger than this due to
-- network overhead, etc.
jobStillRunningTimeoutSeconds :: Int
jobStillRunningTimeoutSeconds = 50

data ProjectMessagesOutput = ProjectMessagesOutput
    { pmoStatusSnap  :: Maybe ProjectStatusSnapshot
      -- ^ Note: The usage of @Maybe@ here is purely a bandwidth optimization.
      -- Semantically, it is more correct to simply include the snapshot each
      -- time. To avoid passing back the same information, however, the
      -- snapshot is only transferred when the current hash does not match the
      -- hash provided in the request.
    , pmoStatusHash  :: StatusHash
      -- ^ The current hash at the time messages were returned.
    , pmoLastMessage :: Integer
      -- ^ The highest message ID we've yet seen, used as next argument in
      -- @ProjectMessagesInput@ to avoid looking at the same messages again.
    , pmoMessages    :: [RunnerMessage]
    , pmoMailboxId   :: MailboxId
    }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Generic
#endif
             )

#ifndef FAY
instance ToJSON ProjectMessagesOutput
instance FromJSON ProjectMessagesOutput
instance Serialize ProjectMessagesOutput
instance Hashable ProjectMessagesOutput
instance NFData ProjectMessagesOutput where rnf = genericRnf
#endif

newtype StatusHash = StatusHash { unStatusHash :: Text }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, PathPiece, ToJSON, FromJSON,
              Serialize, Generic, Hashable, NFData
#endif
             )

data CompileResult
    = CRCanceled
    | CRSuccess
    | CRFailure
    | CRException Text
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )

#ifndef FAY
instance ToJSON CompileResult
instance FromJSON CompileResult
instance Serialize CompileResult
instance Hashable CompileResult
instance NFData CompileResult where rnf = genericRnf
#endif

data ProcessResult
    = PRExitSuccess
    | PRUserException Text
    | PRRunningFailed Text
    | PRGHCException Text
    | PRForceCanceled
    | PRBackendError Text
    | PRCouldNotLoadModule Text
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )

displayProcessResult :: ProcessResult -> Text
displayProcessResult PRExitSuccess = fromString ""
displayProcessResult (PRRunningFailed e) = fromString "Code run failed: " <> e
displayProcessResult (PRUserException e) = fromString "The code threw an exception : " <> e
displayProcessResult (PRGHCException e) = fromString "GHC threw an exception : " <> e
displayProcessResult PRForceCanceled = fromString "The session was restarted"
displayProcessResult (PRBackendError e) = fromString "Process runner caught an exception: " <> e
displayProcessResult (PRCouldNotLoadModule e) = fromString "Could not load module: " <> e

#ifndef FAY
instance ToJSON ProcessResult
instance FromJSON ProcessResult
instance Serialize ProcessResult
instance Hashable ProcessResult
instance NFData ProcessResult where rnf = genericRnf
#endif

data GitShellOutput
    = GSOutput Text
    | GSSuccess
    | GSFailure Int
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Generic
#endif
             )

#ifndef FAY
instance ToJSON GitShellOutput
instance FromJSON GitShellOutput
instance Serialize GitShellOutput
instance Hashable GitShellOutput
instance NFData GitShellOutput where rnf = genericRnf
#endif

data RunnerMessage
    = ProjectMessage LogLevel Text
    | ProcessOutput ProcId Text
    | ProcessStopped ProcId ProcessResult

    | GitShellOutput GitShellId GitShellOutput

    | CompileComplete CompileId CompileResult

    | ProjectHasOpened SessionId
    | ProjectHasClosed SessionId Bool Text
    -- ^ If the Bool is True, it indicates that the client should resume
    -- polling for project messages from a newly created project. If False,
    -- there is some more severe problem initiating the project, and the client
    -- should let the user know that the project may require manual recovery.

    | IdeCommandOutput JobId Text
    -- ^ FIXME At some point in the future, it would be nice to replace the
    -- second Text with a Value, to make it clear that we're encoding arbitrary
    -- JSON values. This is semantically more correct, and more efficient, but
    -- requires changes to the Fay encode/decode code, and therefore is not
    -- trivial to implement.
    | JobException JobId Text
    | JobStillRunning JobId
    -- ^ Indicates to the client that a job is still being actively worked on.
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Generic
#endif
             )

#ifndef FAY
instance ToJSON RunnerMessage
instance FromJSON RunnerMessage
instance Serialize RunnerMessage
instance Hashable RunnerMessage
instance NFData RunnerMessage where rnf = genericRnf
#endif

data LogLevel
    = LevelDebug
    | LevelInfo
    | LevelWarn
    | LevelError
    | LevelOther Text
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )

#ifndef FAY
instance ToJSON LogLevel
instance FromJSON LogLevel
instance Serialize LogLevel
instance Hashable LogLevel
instance NFData LogLevel where rnf = genericRnf
#endif

data SdistTarballInfo = SdistTarballInfo
    { stiPackageName    :: !Text
    , stiVersion        :: !Text
    }
    deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
             , Ord, Generic
#endif
             )

#ifndef FAY
instance ToJSON SdistTarballInfo
instance FromJSON SdistTarballInfo
instance Serialize SdistTarballInfo
instance Hashable SdistTarballInfo
instance NFData SdistTarballInfo where rnf = genericRnf
#endif

data GitHistoryItem = GitHistoryItem
    { ghiDate   :: Text
    , ghiAuthor :: Text
    , ghiLog    :: Text
    , ghiHash   :: CommitSHA
    }
    deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
             , Ord, Generic
#endif
             )
#ifndef FAY
instance ToJSON GitHistoryItem
instance FromJSON GitHistoryItem
instance Serialize GitHistoryItem
instance Hashable GitHistoryItem
instance NFData GitHistoryItem where rnf = genericRnf
#endif

data GitRepositoryStatus
    = GitRepositoryPending
    | GitRepositoryReady
    | GitRepositoryInvalid Text
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )

#ifndef FAY
instance ToJSON GitRepositoryStatus
instance FromJSON GitRepositoryStatus
instance Serialize GitRepositoryStatus
instance Hashable GitRepositoryStatus
instance NFData GitRepositoryStatus where rnf = genericRnf
#endif

data ProjectStatusSnapshot = ProjectStatusSnapshot
    { snapOpeningStatus     :: RunnerOpeningStatus
    , snapCompileStatus     :: RunnerCompileStatus
    , snapProcessStatus     :: ProcessStatusSnapshot
    , snapBuildStatus       :: RunnerBuildStatus
    , snapGitStatus         :: GitRepositoryStatus
    , snapGitCommand        :: Maybe Text
    , snapPictureStatus     :: RunnerPictureStatus
    , snapAnyLocalChanges   :: Bool
    }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Generic
#endif
             )

#ifndef FAY
instance ToJSON ProjectStatusSnapshot
instance FromJSON ProjectStatusSnapshot
instance Serialize ProjectStatusSnapshot
instance Hashable ProjectStatusSnapshot
instance NFData ProjectStatusSnapshot where rnf = genericRnf
#endif

data IdInfo
    = NoIdInfo
    | IdInfo
        { iiResultSpan :: SourceSpan
        , iiSourceInfo :: DefinitionSource
        }
      -- ^ query span, result span, source info
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )

#ifndef FAY
instance ToJSON IdInfo
instance FromJSON IdInfo
instance Serialize IdInfo
instance Hashable IdInfo
instance NFData IdInfo where rnf = genericRnf
#endif

data DefinitionSource
    = DefinitionLocal Text SourceSpan
    | DefinitionTextSpan Text Text
    | DefinitionImported Text ModuleId ModuleId EitherSpan EitherSpan
    | DefinitionWiredIn Text
    | DefinitionBinder Text
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )

definitionIdName :: DefinitionSource -> Text
definitionIdName (DefinitionLocal name _) = name
definitionIdName (DefinitionTextSpan name _) = name
definitionIdName (DefinitionImported name _ _ _ _) = name
definitionIdName (DefinitionWiredIn name) = name
definitionIdName (DefinitionBinder name) = name

#ifndef FAY
instance ToJSON DefinitionSource
instance FromJSON DefinitionSource
instance Serialize DefinitionSource
instance Hashable DefinitionSource
instance NFData DefinitionSource where rnf = genericRnf
#endif

data ModuleId = ModuleId (Maybe EncFileName) ModuleName PackageId
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )

#ifndef FAY
instance ToJSON ModuleId
instance FromJSON ModuleId
instance Serialize ModuleId
instance Hashable ModuleId
instance NFData ModuleId where rnf = genericRnf
#endif

data AutoCompleteInput = AutoCompleteInput
    { aciFileName :: EncFileName
    , aciPrefix   :: Text
    }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )

#ifndef FAY
instance ToJSON AutoCompleteInput
instance FromJSON AutoCompleteInput
instance Serialize AutoCompleteInput
instance Hashable AutoCompleteInput
instance NFData AutoCompleteInput where rnf = genericRnf
#endif

data PackageId = PackageId
    { packageName    :: Text
    , packageVersion :: Maybe Text
    }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )

#ifndef FAY
instance ToJSON PackageId
instance FromJSON PackageId
instance Serialize PackageId
instance Hashable PackageId
instance NFData PackageId where rnf = genericRnf
#endif

data SearchResult = SearchResult SourceSpan [Either Text Text]
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )

#ifndef FAY
instance ToJSON SearchResult
instance FromJSON SearchResult
instance Serialize SearchResult
instance Hashable SearchResult
instance NFData SearchResult where rnf = genericRnf
#endif

data HoogleResult = HoogleResult
    { hrURL     :: String
    , hrSources :: [(PackageLink, [ModuleLink])]
    , hrTitle   :: String -- ^ HTML
    , hrBody    :: String -- ^ plain text
    }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )

#ifndef FAY
instance ToJSON HoogleResult
instance FromJSON HoogleResult
instance Serialize HoogleResult
instance Hashable HoogleResult
instance NFData HoogleResult where rnf = genericRnf
#endif

data PackageLink = PackageLink
    { plName :: String
    , plURL  :: String
    }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )

#ifndef FAY
instance ToJSON PackageLink
instance FromJSON PackageLink
instance Serialize PackageLink
instance Hashable PackageLink
instance NFData PackageLink where rnf = genericRnf
#endif

data ModuleLink = ModuleLink
    { mlName :: String
    , mlURL :: String
    }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )

#ifndef FAY
instance ToJSON ModuleLink
instance FromJSON ModuleLink
instance Serialize ModuleLink
instance Hashable ModuleLink
instance NFData ModuleLink where rnf = genericRnf
#endif

data RunnerOpeningStatus
    = RunnerProjectOpening Text
    | RunnerProjectOpen
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )

#ifndef FAY
instance Serialize RunnerOpeningStatus
instance Hashable RunnerOpeningStatus
instance NFData RunnerOpeningStatus where rnf = genericRnf

instance Monoid RunnerOpeningStatus where
    mempty = RunnerProjectOpening "Project opening..."
    mappend _ y = y

instance ToJSON RunnerOpeningStatus
instance FromJSON RunnerOpeningStatus
#endif

data RunnerCompileStatus
    = RunnerNotCompiling
    | RunnerCompiling CompileIdent Progress
    | RunnerCompileDone CompileIdent [SourceInfo]
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Generic
#endif
             )

#ifndef FAY
instance ToJSON RunnerCompileStatus
instance FromJSON RunnerCompileStatus
instance Serialize RunnerCompileStatus
instance Hashable RunnerCompileStatus
instance NFData RunnerCompileStatus where rnf = genericRnf

instance Monoid RunnerCompileStatus where
    mempty = RunnerNotCompiling
    mappend _ y = y
#endif

-- | An error or warning in a source module.
--
-- Most errors are associated with a span of text, but some have only a
-- location point.
--
data SourceInfo = SourceInfo
  { infoKind :: SourceInfoKind
  , infoSpan :: EitherSpan
  , infoMsg  :: [(InfoChunkTag, Text)]
  }
  deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
           , Ord, Generic
#endif
           )

#ifndef FAY
instance ToJSON SourceInfo
instance FromJSON SourceInfo
instance Serialize SourceInfo
instance Hashable SourceInfo
instance NFData SourceInfo where rnf = genericRnf
#endif

-- | Severity of a piece of info.
data SourceInfoKind = SIKError | SIKWarning | SIKMismatch | SIKHint
  deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
           , Ord, Generic
#endif
           )

#ifndef FAY
instance ToJSON SourceInfoKind
instance FromJSON SourceInfoKind
instance Serialize SourceInfoKind
instance Hashable SourceInfoKind
instance NFData SourceInfoKind where rnf = genericRnf
#endif

data InfoChunkTag
    = ICTPlain
    | ICTModule
    | ICTCode -- ^ Note: Ideally we'd distinguish identifiers, types, exprs, etc
    | ICTRefactor Text [(SourceSpan, Text)]
        -- ^ The 'Text' is a description of the action (for use in hovertext),
        --   and the list stores the replacements that should be performed.
    | ICTCollapse
    | ICTOriginal
  deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
           , Ord, Generic
#endif
           )

#ifndef FAY
instance ToJSON InfoChunkTag
instance FromJSON InfoChunkTag
instance Serialize InfoChunkTag
instance Hashable InfoChunkTag
instance NFData InfoChunkTag where rnf = genericRnf
#endif

data ProcessStatusSnapshot
    = SnapshotNoProcess
    | SnapshotProcessRunning       ProcId (Maybe Text) -- ^ URL to visit project
  deriving (Read, Typeable, Data, Show, Eq
#ifndef FAY
           , Ord, Generic
#endif
           )

#ifndef FAY
instance ToJSON ProcessStatusSnapshot
instance FromJSON ProcessStatusSnapshot
instance Serialize ProcessStatusSnapshot
instance Hashable ProcessStatusSnapshot
instance NFData ProcessStatusSnapshot where rnf = genericRnf
#endif

-- | Status for the pictures directory.
data RunnerPictureStatus
  = RunnerPictureStatus [PictureStatus]
#ifndef FAY
   deriving (Eq, Read, Show, Data, Typeable, Generic, Ord)
#else
  deriving (Show,Eq,Read,Data,Typeable)
#endif

#ifndef FAY
instance ToJSON RunnerPictureStatus
instance FromJSON RunnerPictureStatus
instance Serialize RunnerPictureStatus
instance Hashable RunnerPictureStatus
instance NFData RunnerPictureStatus where rnf = genericRnf

instance Monoid RunnerPictureStatus where
  mempty = RunnerPictureStatus []
  mappend (RunnerPictureStatus x) (RunnerPictureStatus y) = RunnerPictureStatus (x <> y)
#endif

-- | Status of a picture.
data PictureStatus = PictureStatus
  { pictureName :: Text -- ^ The title to use in the IDE UI.
  , pictureUrl :: Text  -- ^ URL of the actual image.
  , pictureHash :: Text -- ^ Hash of the file contents, whenever the
                        -- picture changes this is updated.
  }
#ifndef FAY
  deriving (Eq,Show,Generic,Typeable,Data,Ord,Read)
#else
  deriving (Show,Eq,Read,Data,Typeable)
#endif

#ifndef FAY
instance ToJSON PictureStatus
instance FromJSON PictureStatus
instance Serialize PictureStatus
instance Hashable PictureStatus
instance NFData PictureStatus where rnf = genericRnf
#endif

data RunnerBuildStatus
    = RunnerNotBuilding
    | RunnerBuilding Progress
    | RunnerUploading
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )

#ifndef FAY
instance Serialize RunnerBuildStatus
instance Hashable RunnerBuildStatus
instance NFData RunnerBuildStatus where rnf = genericRnf

instance ToJSON RunnerBuildStatus
instance FromJSON RunnerBuildStatus

instance Monoid RunnerBuildStatus where
    mempty = RunnerNotBuilding
    mappend _ y = y
#endif

data UploadedBuild = UploadedBuild
    { ubUrl :: Text
    , ubExe :: Text
    }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )

#ifndef FAY
instance ToJSON UploadedBuild
instance FromJSON UploadedBuild
instance Serialize UploadedBuild
instance Hashable UploadedBuild
instance NFData UploadedBuild where rnf = genericRnf
#endif

-- | This type represents intermediate progress information during compilation.
data Progress = Progress
    {
      -- | The current step number
      --
      -- When these Progress messages are generated from progress updates from
      -- ghc, it is entirely possible that we might get step 4/26, 16/26, 3/26;
      -- the steps may not be continuous, might even be out of order, and may
      -- not finish at X/X.
      progressStep :: Int

      -- | The total number of steps
    , progressNumSteps :: Int

      -- | The parsed message. For instance, in the case of progress messages
      -- during compilation, 'progressOrigMsg' might be
      --
      -- > [1 of 2] Compiling M (some/path/to/file.hs, some/other/path/to/file.o)
      --
      -- while 'progressMsg' will just be 'Compiling M'
    , progressMsg :: Text
    }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )

#ifndef FAY
instance ToJSON Progress
instance FromJSON Progress
instance Serialize Progress
instance Hashable Progress
instance NFData Progress where rnf = genericRnf
#endif

newtype Approot = Approot { unApproot :: Text }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, PathPiece, ToJSON, FromJSON,
              Serialize, Generic, Hashable, NFData
#endif
             )

newtype VirtualHost = VirtualHost { unVirtualHost :: Text }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, PathPiece, ToJSON, FromJSON,
              Serialize, Generic, Hashable
#endif
             )

#ifndef FAY
approotString :: Approot -> String
approotString (Approot txt) = toString txt
#endif

data ApprootPid = ApprootPid Approot ProcId
    deriving (Read, Typeable, Data, Show, Eq)

newtype Port = Port { getPort :: Int }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Num, Enum, Bounded, Real, Integral, Ord,
              PathPiece, ToJSON, FromJSON,
              Serialize, Generic, Hashable, NFData
#endif
             )

data ErrorsAnd x = ErrorsAnd [String] (Maybe (Automatic x))
    deriving (Read, Typeable, Data, Show, Eq)

data ModuleIncluded
    = ModuleExcluded
    | ModuleWrongExtension
    | ModuleNotTextual
    | ModuleIsCFile
    | ModuleIsBootFile ModuleName
    | ModuleHeaderFilenameMismatch ModuleName
    | ModuleNameAmbiguous ModuleName
    | ModuleIncluded ModuleName
    deriving (Read, Typeable, Data, Show, Eq)

fileDescToModuleIncluded :: FileDesc -> ModuleIncluded
fileDescToModuleIncluded fd =
    if fdUserExcluded fd
        then ModuleExcluded
        else case (fdModuleStatus fd, fdFileType fd) of
            (WrongExtension,            _         ) -> ModuleWrongExtension
            (NotTextual,                _         ) -> ModuleNotTextual
            (CFile,                     _         ) -> ModuleIsCFile
            (BootFile mn,               _         ) -> ModuleIsBootFile mn
            (HeaderFilenameMismatch mn, _         ) -> ModuleHeaderFilenameMismatch mn
            (ModuleOk mn,               DataFile  ) -> ModuleNameAmbiguous mn
            (ModuleOk mn,               SourceFile) -> ModuleIncluded mn

data MergeModifyKind = Modified | Added | Deleted | TypeChanged
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )

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

data MergeModifyPair = MergeModifyPair MergeModifyKind MergeModifyKind
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
              , Ord, Generic
#endif
             )

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

-- | A Git blob SHA in textual form.
newtype BlobSHA = BlobSHA { unBlobSHA :: Text }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
             , Ord, Serialize, Generic, Hashable
             , ToJSON, FromJSON, PathPiece
             , PersistField
             , ToMarkup, ToMessage
#endif
             )
#ifndef FAY
instance PersistFieldSql BlobSHA where
    sqlType = sqlType . liftM unBlobSHA
#endif

-- | A Git commit SHA in textual form.
newtype CommitSHA = CommitSHA { unCommitSHA :: Text }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
             , Ord, Serialize, Generic, Hashable, NFData
             , ToJSON, FromJSON, PathPiece
             , PersistField
             , ToMarkup, ToMessage
#endif
             )
#ifndef FAY
instance PersistFieldSql CommitSHA where
    sqlType = sqlType . liftM unCommitSHA
#endif

-- | A Git branch name, such as "master", or "merge/master".
newtype BranchName = BranchName { unBranchName :: Text }
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
             , Ord, Serialize, Generic, Hashable
             , ToJSON, FromJSON, PathPiece
#endif
             )

#ifndef FAY
branchToRef :: BranchName -> Text
branchToRef (BranchName name) = "refs/heads/" <> name

branchFromRef :: Text -> BranchName
branchFromRef name =
    BranchName (T.reverse . T.takeWhile (/='/') . T.reverse $ name)

isMergeBranch :: BranchName -> Bool
isMergeBranch (BranchName name) = "merge/" `T.isPrefixOf` name

mergeBranch :: BranchName -> BranchName
mergeBranch b@(BranchName name)
    | isMergeBranch b = b
    | otherwise = BranchName ("merge/" <> name)

mergeBranchOrigin :: BranchName -> Maybe BranchName
mergeBranchOrigin name =
    BranchName <$> T.stripPrefix "merge/" (unBranchName name)
#endif

-- | A reference to a specific commit, which can be done by several different
--   means.
data CommitName = CommitByBranch BranchName
                | CommitBySHA CommitSHA
    deriving (Eq, Read, Show, Data, Typeable
#ifndef FAY
             , Ord, Generic
#endif
             )

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

-- These go at the end to avoid splitting up the module
#ifndef FAY
derivePersistField "MergeModifyKind"
derivePersistField "MergeModifyPair"
#endif