module IHP.IDE.Types where

import ClassyPrelude
import System.Process.Internals
import qualified System.Process as Process
import qualified GHC.IO.Handle as Handle
import qualified Network.WebSockets as Websocket
import qualified Data.ByteString.Char8 as ByteString
import IHP.IDE.PortConfig
import Data.String.Conversions (cs)
import Data.UUID
import qualified IHP.Log.Types as Log
import qualified IHP.Log as Log
import qualified Data.ByteString.Builder as ByteString

data ManagedProcess = ManagedProcess
    { ManagedProcess -> Handle
inputHandle :: !Handle
    , ManagedProcess -> Handle
outputHandle :: !Handle
    , ManagedProcess -> Handle
errorHandle :: !Handle
    , ManagedProcess -> ProcessHandle
processHandle :: !ProcessHandle
    } deriving (Int -> ManagedProcess -> ShowS
[ManagedProcess] -> ShowS
ManagedProcess -> String
(Int -> ManagedProcess -> ShowS)
-> (ManagedProcess -> String)
-> ([ManagedProcess] -> ShowS)
-> Show ManagedProcess
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ManagedProcess] -> ShowS
$cshowList :: [ManagedProcess] -> ShowS
show :: ManagedProcess -> String
$cshow :: ManagedProcess -> String
showsPrec :: Int -> ManagedProcess -> ShowS
$cshowsPrec :: Int -> ManagedProcess -> ShowS
Show)

createManagedProcess :: CreateProcess -> IO ManagedProcess
createManagedProcess :: CreateProcess -> IO ManagedProcess
createManagedProcess CreateProcess
config = do
    (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
process <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
Process.createProcess CreateProcess
config
    case (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
process of
        (Just Handle
inputHandle, Just Handle
outputHandle, Just Handle
errorHandle, ProcessHandle
processHandle) -> ManagedProcess -> IO ManagedProcess
forall (f :: * -> *) a. Applicative f => a -> f a
pure ManagedProcess :: Handle -> Handle -> Handle -> ProcessHandle -> ManagedProcess
ManagedProcess { Handle
ProcessHandle
processHandle :: ProcessHandle
errorHandle :: Handle
outputHandle :: Handle
inputHandle :: Handle
$sel:processHandle:ManagedProcess :: ProcessHandle
$sel:errorHandle:ManagedProcess :: Handle
$sel:outputHandle:ManagedProcess :: Handle
$sel:inputHandle:ManagedProcess :: Handle
.. }
        (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
_ -> String -> IO ManagedProcess
forall a. HasCallStack => String -> a
error String
"createManagedProcess: Some pipes could not be created"

cleanupManagedProcess :: ManagedProcess -> IO ()
cleanupManagedProcess :: ManagedProcess -> IO ()
cleanupManagedProcess (ManagedProcess { Handle
ProcessHandle
processHandle :: ProcessHandle
errorHandle :: Handle
outputHandle :: Handle
inputHandle :: Handle
$sel:processHandle:ManagedProcess :: ManagedProcess -> ProcessHandle
$sel:errorHandle:ManagedProcess :: ManagedProcess -> Handle
$sel:outputHandle:ManagedProcess :: ManagedProcess -> Handle
$sel:inputHandle:ManagedProcess :: ManagedProcess -> Handle
.. }) = (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
Process.cleanupProcess (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
inputHandle, Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
outputHandle, Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
errorHandle, ProcessHandle
processHandle)

sendGhciCommand :: (?context :: Context) => ManagedProcess -> ByteString -> IO ()
sendGhciCommand :: ManagedProcess -> ByteString -> IO ()
sendGhciCommand ManagedProcess { Handle
inputHandle :: Handle
$sel:inputHandle:ManagedProcess :: ManagedProcess -> Handle
inputHandle } ByteString
command = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Context -> Bool
isDebugMode ?context::Context
Context
?context) (Text -> IO ()
forall context string.
(?context::context, LoggingProvider context, ToLogStr string) =>
string -> IO ()
Log.debug (Text
"GHCI: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
command :: Text))
    Handle -> ByteString -> IO ()
ByteString.hPutStrLn Handle
inputHandle ByteString
command
    Handle -> IO ()
Handle.hFlush Handle
inputHandle

data OutputLine = StandardOutput !ByteString | ErrorOutput !ByteString deriving (Int -> OutputLine -> ShowS
[OutputLine] -> ShowS
OutputLine -> String
(Int -> OutputLine -> ShowS)
-> (OutputLine -> String)
-> ([OutputLine] -> ShowS)
-> Show OutputLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutputLine] -> ShowS
$cshowList :: [OutputLine] -> ShowS
show :: OutputLine -> String
$cshow :: OutputLine -> String
showsPrec :: Int -> OutputLine -> ShowS
$cshowsPrec :: Int -> OutputLine -> ShowS
Show, OutputLine -> OutputLine -> Bool
(OutputLine -> OutputLine -> Bool)
-> (OutputLine -> OutputLine -> Bool) -> Eq OutputLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputLine -> OutputLine -> Bool
$c/= :: OutputLine -> OutputLine -> Bool
== :: OutputLine -> OutputLine -> Bool
$c== :: OutputLine -> OutputLine -> Bool
Eq)

data Action =
    UpdatePostgresState PostgresState
    | UpdateAppGHCIState AppGHCIState
    | AppModulesLoaded { Action -> Bool
success :: !Bool }
    | AppStarted
    | ReceiveAppOutput { Action -> OutputLine
line :: !OutputLine }
    | AssetChanged
    | HaskellFileChanged
    | SchemaChanged
    | UpdateStatusServerState !StatusServerState
    | UpdateLiveReloadNotificationServerState !LiveReloadNotificationServerState
    | UpdateFileWatcherState !FileWatcherState
    | UpdateToolServerState !ToolServerState
    | PauseApp
    deriving (Int -> Action -> ShowS
[Action] -> ShowS
Action -> String
(Int -> Action -> ShowS)
-> (Action -> String) -> ([Action] -> ShowS) -> Show Action
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Action] -> ShowS
$cshowList :: [Action] -> ShowS
show :: Action -> String
$cshow :: Action -> String
showsPrec :: Int -> Action -> ShowS
$cshowsPrec :: Int -> Action -> ShowS
Show)

data PostgresState
    = PostgresNotStarted
    | StartingPostgres
    | PostgresStarted { PostgresState -> ManagedProcess
process :: !ManagedProcess, PostgresState -> IORef Builder
standardOutput :: !(IORef ByteString.Builder), PostgresState -> IORef Builder
errorOutput :: !(IORef ByteString.Builder) }

instance Show PostgresState where
    show :: PostgresState -> String
show PostgresState
PostgresNotStarted = String
"NotStarted"
    show PostgresState
StartingPostgres = String
"Starting"
    show PostgresStarted { } = String
"Started"

data AppGHCIState
    = AppGHCINotStarted
    | AppGHCILoading { AppGHCIState -> ManagedProcess
process :: !ManagedProcess }
    | AppGHCIModulesLoaded { process :: !ManagedProcess }
    | RunningAppGHCI { process :: !ManagedProcess }

instance Show AppGHCIState where
    show :: AppGHCIState -> String
show AppGHCIState
AppGHCINotStarted = String
"NotStarted"
    show AppGHCILoading { } = String
"Loading"
    show AppGHCIModulesLoaded { } = String
"Loaded"
    show RunningAppGHCI { } = String
"Running"

data LiveReloadNotificationServerState
    = LiveReloadNotificationServerState { LiveReloadNotificationServerState -> IORef (Map UUID Connection)
clients :: !(IORef (Map UUID Websocket.Connection)) }

instance Show LiveReloadNotificationServerState where
    show :: LiveReloadNotificationServerState -> String
show LiveReloadNotificationServerState { } = String
"LiveReloadNotificationServerState"

data FileWatcherState
    = FileWatcherNotStarted
    | FileWatcherStarted { FileWatcherState -> Async ()
thread :: !(Async ()) }

instance Show FileWatcherState where
    show :: FileWatcherState -> String
show FileWatcherState
FileWatcherNotStarted = String
"NotStarted"
    show FileWatcherStarted { } = String
"Started"

data StatusServerState
    = StatusServerNotStarted
    | StatusServerStarted
        { StatusServerState -> IORef (Async ())
serverRef :: !(IORef (Async ()))
        , StatusServerState -> IORef [(Connection, MVar ())]
clients :: !(IORef [(Websocket.Connection, MVar ())])
        , StatusServerState -> IORef [ByteString]
standardOutput :: !(IORef [ByteString])
        , StatusServerState -> IORef [ByteString]
errorOutput :: !(IORef [ByteString])
        }
    | StatusServerPaused
        { serverRef :: !(IORef (Async ()))
        , clients :: !(IORef [(Websocket.Connection, MVar ())])
        , standardOutput :: !(IORef [ByteString])
        , errorOutput :: !(IORef [ByteString])
        }

instance Show StatusServerState where
    show :: StatusServerState -> String
show StatusServerState
StatusServerNotStarted = String
"NotStarted"
    show StatusServerStarted { } = String
"Started"
    show StatusServerPaused { } = String
"Paused"

data ToolServerState
    = ToolServerNotStarted
    | ToolServerStarted { ToolServerState -> Async ()
thread :: !(Async ()) }

instance Show ToolServerState where
    show :: ToolServerState -> String
show ToolServerState
ToolServerNotStarted = String
"NotStarted"
    show ToolServerStarted {} = String
"Started"


instance Show (IORef x) where show :: IORef x -> String
show IORef x
_ = String
"(..)"
instance Show ProcessHandle where show :: ProcessHandle -> String
show ProcessHandle
_ = String
"(..)"
instance Show (Async ()) where show :: Async () -> String
show Async ()
_ = String
"(..)"

data AppState = AppState
    { AppState -> PostgresState
postgresState :: !PostgresState
    , AppState -> AppGHCIState
appGHCIState :: !AppGHCIState
    , AppState -> StatusServerState
statusServerState :: !StatusServerState
    , AppState -> LiveReloadNotificationServerState
liveReloadNotificationServerState :: !LiveReloadNotificationServerState
    , AppState -> FileWatcherState
fileWatcherState :: !FileWatcherState
    , AppState -> ToolServerState
toolServerState :: !ToolServerState
    , AppState -> IORef Bool
databaseNeedsMigration :: !(IORef Bool)
    } deriving (Int -> AppState -> ShowS
[AppState] -> ShowS
AppState -> String
(Int -> AppState -> ShowS)
-> (AppState -> String) -> ([AppState] -> ShowS) -> Show AppState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AppState] -> ShowS
$cshowList :: [AppState] -> ShowS
show :: AppState -> String
$cshow :: AppState -> String
showsPrec :: Int -> AppState -> ShowS
$cshowsPrec :: Int -> AppState -> ShowS
Show)

emptyAppState :: IO AppState
emptyAppState :: IO AppState
emptyAppState = do
    IORef (Map UUID Connection)
clients <- Map UUID Connection -> IO (IORef (Map UUID Connection))
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Map UUID Connection
forall a. Monoid a => a
mempty
    IORef Bool
databaseNeedsMigration <- Bool -> IO (IORef Bool)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Bool
False
    AppState -> IO AppState
forall (f :: * -> *) a. Applicative f => a -> f a
pure AppState :: PostgresState
-> AppGHCIState
-> StatusServerState
-> LiveReloadNotificationServerState
-> FileWatcherState
-> ToolServerState
-> IORef Bool
-> AppState
AppState
        { $sel:postgresState:AppState :: PostgresState
postgresState = PostgresState
PostgresNotStarted
        , $sel:appGHCIState:AppState :: AppGHCIState
appGHCIState = AppGHCIState
AppGHCINotStarted
        , $sel:statusServerState:AppState :: StatusServerState
statusServerState = StatusServerState
StatusServerNotStarted
        , $sel:liveReloadNotificationServerState:AppState :: LiveReloadNotificationServerState
liveReloadNotificationServerState = LiveReloadNotificationServerState :: IORef (Map UUID Connection) -> LiveReloadNotificationServerState
LiveReloadNotificationServerState { IORef (Map UUID Connection)
clients :: IORef (Map UUID Connection)
$sel:clients:LiveReloadNotificationServerState :: IORef (Map UUID Connection)
clients }
        , $sel:fileWatcherState:AppState :: FileWatcherState
fileWatcherState = FileWatcherState
FileWatcherNotStarted
        , $sel:toolServerState:AppState :: ToolServerState
toolServerState = ToolServerState
ToolServerNotStarted
        , IORef Bool
databaseNeedsMigration :: IORef Bool
$sel:databaseNeedsMigration:AppState :: IORef Bool
databaseNeedsMigration
        }

data Context = Context
    { Context -> MVar Action
actionVar :: !(MVar Action)
    , Context -> PortConfig
portConfig :: !PortConfig
    , Context -> IORef AppState
appStateRef :: !(IORef AppState)
    , Context -> Bool
isDebugMode :: !Bool
    , Context -> Logger
logger :: !Log.Logger
    }

dispatch :: (?context :: Context) => Action -> IO ()
dispatch :: Action -> IO ()
dispatch = let Context { Bool
IORef AppState
MVar Action
Logger
PortConfig
logger :: Logger
isDebugMode :: Bool
appStateRef :: IORef AppState
portConfig :: PortConfig
actionVar :: MVar Action
$sel:logger:Context :: Context -> Logger
$sel:appStateRef:Context :: Context -> IORef AppState
$sel:portConfig:Context :: Context -> PortConfig
$sel:actionVar:Context :: Context -> MVar Action
$sel:isDebugMode:Context :: Context -> Bool
.. } = ?context::Context
Context
?context in MVar Action -> Action -> IO ()
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar MVar Action
actionVar

instance Log.LoggingProvider Context where
    getLogger :: Context -> Logger
getLogger Context { Logger
logger :: Logger
$sel:logger:Context :: Context -> Logger
logger } = Logger
logger