module Solr.Service
( Solr(..)
, initSolr
, finiSolr
, MonadSolr
) where
import Control.Monad (when)
import Control.Monad.IO.Class
import Data.Maybe (isNothing, fromMaybe)
import qualified Network.HTTP.Client as HC
import System.Directory (makeAbsolute)
import System.Environment (getEnvironment)
import System.FilePath ((</>))
import System.IO (openFile, IOMode(AppendMode))
import qualified System.Process as Proc
import System.Timeout (timeout)
import Ops
import Has
import qualified Store.Config as C
import HTTP.Client (HTTPClient)
data Solr = Solr
{ solrRequest :: HC.Request
, solrProcess :: Maybe Proc.ProcessHandle
}
initSolr :: Bool -> C.Config -> IO Solr
initSolr fg conf = do
home <- makeAbsolute $ conf C.! "home"
env <- getEnvironment
out <- maybe (return Proc.Inherit) (\f -> Proc.UseHandle <$> openFile f AppendMode) $ conf C.! "log"
let run = conf C.! "run"
print $ "RUN" ++ show run
print $ "HOME" ++ show home
p <- fromMaybe fg run `thenReturn`
Proc.createProcess (Proc.proc (fromMaybe "solr" $ conf C.! "bin")
["start", "-Djetty.host=" ++ host, "-p", show port, "-f", "-s", home])
{ Proc.std_out = out
, Proc.std_err = out
, Proc.close_fds = True
, Proc.env = Just $ env ++ [("SOLR_PID_DIR", home), ("LOG4J_PROPS", home </> "log4j.properties")]
, Proc.create_group = True
}
req <- HC.parseRequest $ "http://" ++ host ++ "/solr/" ++ core ++ "/"
return Solr
{ solrRequest = req
{ HC.port = port
, HC.redirectCount = 0
, HC.cookieJar = Nothing
}
, solrProcess = (\(_,_,_,h) -> h) <$> p
}
where
host = fromMaybe "127.0.0.1" $ conf C.! "host"
port = conf C.! "port"
core = fromMaybe "databrary" $ conf C.! "core"
finiSolr :: Solr -> IO ()
finiSolr Solr{ solrProcess = Just ph } = do
Proc.interruptProcessGroupOf ph
r <- timeout 10000000 $ Proc.waitForProcess ph
when (isNothing r) $ do
putStrLn "solr failed to stop; terminating..."
Proc.terminateProcess ph
finiSolr _ = return ()
type MonadSolr c m = (MonadIO m, MonadHas HTTPClient c m, MonadHas Solr c m)