{-|
Module: IHP.IDE.ToolServer.Helper.Controller
Description: Provides helpers for controllers of the ToolServer
Copyright: (c) digitally induced GmbH, 2020
-}
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

-- | Returns the port used by the running app. Usually returns @8000@.
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 ()

-- | Returns the editor command for the user and also whether the command supports line and col notation
--
-- Line and col notation means that calling @editor myfile.hs:10:5@ works. Tools like @xdg-open@ or on macOS @open@
-- don't support this notation and thus need to be called like @xdg-open myfile.hs@ instead of @xdg-open myfile.hs:10:5@
--
-- Looks for a the env vars IHP_EDITOR or EDITOR. As fallback it uses @open@ or @xdg-open@ (depends on OS).
--
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 ()