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
import qualified Control.Concurrent.Chan.Unagi as Queue

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
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) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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)
_ -> 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 (forall a. a -> Maybe a
Just Handle
inputHandle, forall a. a -> Maybe a
Just Handle
outputHandle, forall a. a -> Maybe a
Just Handle
errorHandle, ProcessHandle
processHandle)

sendGhciCommand :: (?context :: Context) => ManagedProcess -> ByteString -> IO ()
sendGhciCommand :: (?context::Context) => ManagedProcess -> ByteString -> IO ()
sendGhciCommand ManagedProcess { Handle
inputHandle :: Handle
$sel:inputHandle:ManagedProcess :: ManagedProcess -> Handle
inputHandle } ByteString
command = do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Context -> Bool
isDebugMode ?context::Context
?context) (forall context string.
(?context::context, LoggingProvider context, ToLogStr string) =>
string -> IO ()
Log.debug (Text
"GHCI: " forall a. Semigroup a => a -> a -> a
<> 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
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
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
    | AssetChanged
    | HaskellFileChanged
    | SchemaChanged
    | UpdateStatusServerState !StatusServerState
    | PauseApp
    deriving (Int -> Action -> ShowS
[Action] -> ShowS
Action -> String
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 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"


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 -> IORef Bool
databaseNeedsMigration :: !(IORef Bool)
    , AppState -> IORef (Maybe SomeException)
lastSchemaCompilerError :: !(IORef (Maybe SomeException))
    } deriving (Int -> AppState -> ShowS
[AppState] -> ShowS
AppState -> String
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 Bool
databaseNeedsMigration <- forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Bool
False
    IORef (Maybe SomeException)
lastSchemaCompilerError <- forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef forall a. Maybe a
Nothing
    forall (f :: * -> *) a. Applicative f => a -> f a
pure AppState
        { $sel:postgresState:AppState :: PostgresState
postgresState = PostgresState
PostgresNotStarted
        , $sel:appGHCIState:AppState :: AppGHCIState
appGHCIState = AppGHCIState
AppGHCINotStarted
        , $sel:statusServerState:AppState :: StatusServerState
statusServerState = StatusServerState
StatusServerNotStarted
        , IORef Bool
databaseNeedsMigration :: IORef Bool
$sel:databaseNeedsMigration:AppState :: IORef Bool
databaseNeedsMigration
        , IORef (Maybe SomeException)
lastSchemaCompilerError :: IORef (Maybe SomeException)
$sel:lastSchemaCompilerError:AppState :: IORef (Maybe SomeException)
lastSchemaCompilerError
        }

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
    , Context -> InChan OutputLine
ghciInChan :: !(Queue.InChan OutputLine) -- ^ Output of the app ghci is written here
    , Context -> OutChan OutputLine
ghciOutChan :: !(Queue.OutChan OutputLine) -- ^ Output of the app ghci is consumed here
    , Context -> IORef (Map UUID Connection)
liveReloadClients :: !(IORef (Map UUID Websocket.Connection))
    }

dispatch :: (?context :: Context) => Action -> IO ()
dispatch :: (?context::Context) => Action -> IO ()
dispatch = let Context { Bool
IORef (Map UUID Connection)
IORef AppState
MVar Action
Logger
InChan OutputLine
OutChan OutputLine
PortConfig
liveReloadClients :: IORef (Map UUID Connection)
ghciOutChan :: OutChan OutputLine
ghciInChan :: InChan OutputLine
logger :: Logger
isDebugMode :: Bool
appStateRef :: IORef AppState
portConfig :: PortConfig
actionVar :: MVar Action
$sel:liveReloadClients:Context :: Context -> IORef (Map UUID Connection)
$sel:ghciOutChan:Context :: Context -> OutChan OutputLine
$sel:ghciInChan:Context :: Context -> InChan OutputLine
$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 in forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar MVar Action
actionVar