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
(Int -> ManagedProcess -> ShowS)
-> (ManagedProcess -> String)
-> ([ManagedProcess] -> ShowS)
-> Show ManagedProcess
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ManagedProcess -> ShowS
showsPrec :: Int -> ManagedProcess -> ShowS
$cshow :: ManagedProcess -> String
show :: ManagedProcess -> String
$cshowList :: [ManagedProcess] -> ShowS
showList :: [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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ManagedProcess { Handle
ProcessHandle
$sel:inputHandle:ManagedProcess :: Handle
$sel:outputHandle:ManagedProcess :: Handle
$sel:errorHandle:ManagedProcess :: Handle
$sel:processHandle:ManagedProcess :: ProcessHandle
inputHandle :: Handle
outputHandle :: Handle
errorHandle :: Handle
processHandle :: ProcessHandle
.. }
        (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
$sel:inputHandle:ManagedProcess :: ManagedProcess -> Handle
$sel:outputHandle:ManagedProcess :: ManagedProcess -> Handle
$sel:errorHandle:ManagedProcess :: ManagedProcess -> Handle
$sel:processHandle:ManagedProcess :: ManagedProcess -> ProcessHandle
inputHandle :: Handle
outputHandle :: Handle
errorHandle :: Handle
processHandle :: ProcessHandle
.. }) = (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 :: (?context::Context) => ManagedProcess -> ByteString -> IO ()
sendGhciCommand ManagedProcess { Handle
$sel:inputHandle:ManagedProcess :: ManagedProcess -> Handle
inputHandle :: 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
$cshowsPrec :: Int -> OutputLine -> ShowS
showsPrec :: Int -> OutputLine -> ShowS
$cshow :: OutputLine -> String
show :: OutputLine -> String
$cshowList :: [OutputLine] -> ShowS
showList :: [OutputLine] -> ShowS
Show, OutputLine -> OutputLine -> Bool
(OutputLine -> OutputLine -> Bool)
-> (OutputLine -> OutputLine -> Bool) -> Eq OutputLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OutputLine -> OutputLine -> Bool
== :: OutputLine -> OutputLine -> Bool
$c/= :: OutputLine -> OutputLine -> Bool
/= :: OutputLine -> OutputLine -> Bool
Eq)

data Action =
    UpdatePostgresState PostgresState
    | UpdateAppGHCIState AppGHCIState
    | AppModulesLoaded { Action -> Bool
success :: !Bool }
    | AppStarted
    | HaskellFileChanged
    | SchemaChanged
    | UpdateStatusServerState !StatusServerState
    | 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
$cshowsPrec :: Int -> Action -> ShowS
showsPrec :: Int -> Action -> ShowS
$cshow :: Action -> String
show :: Action -> String
$cshowList :: [Action] -> ShowS
showList :: [Action] -> ShowS
Show)

data PostgresState
    = PostgresNotStarted
    | StartingPostgres
    | PostgresReady
    | 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"
    show PostgresReady { } = String
"Ready"

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
(Int -> AppState -> ShowS)
-> (AppState -> String) -> ([AppState] -> ShowS) -> Show AppState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AppState -> ShowS
showsPrec :: Int -> AppState -> ShowS
$cshow :: AppState -> String
show :: AppState -> String
$cshowList :: [AppState] -> ShowS
showList :: [AppState] -> ShowS
Show)

emptyAppState :: IO AppState
emptyAppState :: IO AppState
emptyAppState = do
    IORef Bool
databaseNeedsMigration <- Bool -> IO (IORef Bool)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Bool
False
    IORef (Maybe SomeException)
lastSchemaCompilerError <- Maybe SomeException -> IO (IORef (Maybe SomeException))
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Maybe SomeException
forall a. Maybe a
Nothing
    AppState -> IO AppState
forall a. a -> IO a
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
$sel:databaseNeedsMigration:AppState :: IORef Bool
databaseNeedsMigration :: IORef Bool
databaseNeedsMigration
        , IORef (Maybe SomeException)
$sel:lastSchemaCompilerError:AppState :: IORef (Maybe SomeException)
lastSchemaCompilerError :: 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
$sel:isDebugMode:Context :: Context -> Bool
$sel:actionVar:Context :: Context -> MVar Action
$sel:portConfig:Context :: Context -> PortConfig
$sel:appStateRef:Context :: Context -> IORef AppState
$sel:logger:Context :: Context -> Logger
$sel:ghciInChan:Context :: Context -> InChan OutputLine
$sel:ghciOutChan:Context :: Context -> OutChan OutputLine
$sel:liveReloadClients:Context :: Context -> IORef (Map UUID Connection)
actionVar :: MVar Action
portConfig :: PortConfig
appStateRef :: IORef AppState
isDebugMode :: Bool
logger :: Logger
ghciInChan :: InChan OutputLine
ghciOutChan :: OutChan OutputLine
liveReloadClients :: IORef (Map UUID Connection)
.. } = ?context::Context
Context
?context in MVar Action -> Action -> IO ()
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar MVar Action
actionVar