module IHP.IDE.ToolServer.Helper.Controller
( appPort
, openEditor
, findWebControllers
, findControllers
, findApplications
, theDevServerContext
, clearDatabaseNeedsMigration
, markDatabaseNeedsMigration
) where
import IHP.Prelude
import IHP.ControllerSupport
import IHP.IDE.ToolServer.Types
import qualified IHP.IDE.PortConfig as PortConfig
import IHP.IDE.Types
import qualified Network.Socket as Socket
import qualified System.Process as Process
import System.Info (os)
import qualified IHP.EnvVar as EnvVar
import IHP.Controller.Context
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.Text as Text
import System.Directory
import qualified Data.Text.IO as IO
appPort :: (?context :: ControllerContext) => Socket.PortNumber
appPort :: (?context::ControllerContext) => PortNumber
appPort = (IO ToolServerApplication -> ToolServerApplication
forall a. IO a -> a
unsafePerformIO (forall value.
(?context::ControllerContext, Typeable value) =>
IO value
fromContext @ToolServerApplication)).devServerContext.portConfig.appPort
openEditor :: Text -> Int -> Int -> IO ()
openEditor :: Text -> Int -> Int -> IO ()
openEditor Text
path Int
line Int
col = do
(Bool
supportsLineAndCol, Text
editor) <- IO (Bool, Text)
findEditor
let command :: Text
command =
Text
editor Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Bool
supportsLineAndCol then Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
line Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
col else Text
""
ExitCode
_ <- FilePath -> IO ExitCode
Process.system (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
command)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
supportsLineAndCol (Text -> IO ()
putStrLn Text
"Pro Tip: Set the env var IHP_EDITOR to your favorite editor. Then all your files will be opened at the right line and column where the error is reported.")
() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
findEditor :: IO (Bool, Text)
findEditor :: IO (Bool, Text)
findEditor = do
Maybe Text
ihpEditorEnv <- ByteString -> IO (Maybe Text)
forall (monad :: * -> *) result.
(MonadIO monad, EnvVarReader result) =>
ByteString -> monad (Maybe result)
EnvVar.envOrNothing ByteString
"IHP_EDITOR"
Maybe Text
editorEnv <- ByteString -> IO (Maybe Text)
forall (monad :: * -> *) result.
(MonadIO monad, EnvVarReader result) =>
ByteString -> monad (Maybe result)
EnvVar.envOrNothing ByteString
"EDITOR"
(Bool, Text) -> IO (Bool, Text)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure case [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Text
ihpEditorEnv, Maybe Text
editorEnv] of
(Text
editor:[Text]
_) -> (Bool
True, Text
editor)
[] -> case FilePath
os of
FilePath
"linux" -> (Bool
False, Text
"xdg-open")
FilePath
"darwin" -> (Bool
False, Text
"open")
findWebControllers :: IO [Text]
findWebControllers :: IO [Text]
findWebControllers = do
[FilePath]
directoryFiles <- FilePath -> IO [FilePath]
listDirectory FilePath
"Web/Controller"
let [Text]
controllerFiles :: [Text] = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Text
x -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
"Prelude" Text -> Text -> Bool
`isInfixOf` Text
x Bool -> Bool -> Bool
|| Text
"Context" Text -> Text -> Bool
`isInfixOf` Text
x) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Text) -> [FilePath] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Text
forall a b. ConvertibleStrings a b => a -> b
cs [FilePath]
directoryFiles
[Text] -> IO [Text]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> IO [Text]) -> [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
".hs" Text
"") [Text]
controllerFiles
findControllers :: Text -> IO [Text]
findControllers :: Text -> IO [Text]
findControllers Text
application = do
[FilePath]
directoryFiles <- FilePath -> IO [FilePath]
listDirectory (FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Text
application Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/Controller"
let [Text]
controllerFiles :: [Text] = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Text
x -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
"Prelude" Text -> Text -> Bool
`isInfixOf` Text
x Bool -> Bool -> Bool
|| Text
"Context" Text -> Text -> Bool
`isInfixOf` Text
x) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Text) -> [FilePath] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Text
forall a b. ConvertibleStrings a b => a -> b
cs [FilePath]
directoryFiles
[Text] -> IO [Text]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> IO [Text]) -> [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
".hs" Text
"") [Text]
controllerFiles
findApplications :: IO ([Text])
findApplications :: IO [Text]
findApplications = do
Text
mainhs <- FilePath -> IO Text
IO.readFile FilePath
"Main.hs"
let imports :: [Text]
imports = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Text
line -> Text
"import " Text -> Text -> Bool
`isPrefixOf` Text
line Bool -> Bool -> Bool
&& Text
".FrontController" Text -> Text -> Bool
`isSuffixOf` Text
line) (Text -> [Text]
lines Text
mainhs)
[Text] -> IO [Text]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
removeImport [Text]
imports)
where
removeImport :: Text -> Text
removeImport Text
line = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
".FrontController" Text
"" (HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"import " Text
"" Text
line)
theDevServerContext :: (?context :: ControllerContext) => IO Context
theDevServerContext :: (?context::ControllerContext) => IO Context
theDevServerContext = (.devServerContext) (ToolServerApplication -> Context)
-> IO ToolServerApplication -> IO Context
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall value.
(?context::ControllerContext, Typeable value) =>
IO value
fromContext @ToolServerApplication)
clearDatabaseNeedsMigration :: (?context :: ControllerContext) => IO ()
clearDatabaseNeedsMigration :: (?context::ControllerContext) => IO ()
clearDatabaseNeedsMigration = do
Context
context <- IO Context
(?context::ControllerContext) => IO Context
theDevServerContext
AppState
state <- IORef AppState -> IO AppState
forall a. IORef a -> IO a
readIORef (Context
context.appStateRef)
IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (AppState
state.databaseNeedsMigration) Bool
False
() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
markDatabaseNeedsMigration :: (?context :: ControllerContext) => IO ()
markDatabaseNeedsMigration :: (?context::ControllerContext) => IO ()
markDatabaseNeedsMigration = do
Context
context <- IO Context
(?context::ControllerContext) => IO Context
theDevServerContext
AppState
state <- IORef AppState -> IO AppState
forall a. IORef a -> IO a
readIORef (Context
context.appStateRef)
IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (AppState
state.databaseNeedsMigration) Bool
True
() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()