cabal file loader

This commit is contained in:
Michael Snoyman 2014-11-17 10:35:56 +02:00
parent 0f4ba8595b
commit 437818735c
3 changed files with 69 additions and 16 deletions

View File

@ -3,11 +3,12 @@ module Application
( makeApplication ( makeApplication
, getApplicationDev , getApplicationDev
, makeFoundation , makeFoundation
, cabalLoaderMain
) where ) where
import qualified Aws import qualified Aws
import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent (forkIO, threadDelay)
import Control.Monad.Logger (runLoggingT, LoggingT) import Control.Monad.Logger (runLoggingT, LoggingT, runStdoutLoggingT)
import Control.Monad.Reader (MonadReader (..)) import Control.Monad.Reader (MonadReader (..))
import Control.Monad.Reader (runReaderT, ReaderT) import Control.Monad.Reader (runReaderT, ReaderT)
import Control.Monad.Trans.Control import Control.Monad.Trans.Control
@ -34,7 +35,7 @@ import Yesod.Default.Config
import Yesod.Default.Handlers import Yesod.Default.Handlers
import Yesod.Default.Main import Yesod.Default.Main
import System.Environment (getEnvironment) import System.Environment (getEnvironment)
import Data.BlobStore (HasBlobStore) import Data.BlobStore (HasBlobStore (..), BlobStore)
import qualified Echo import qualified Echo
@ -99,16 +100,32 @@ makeApplication echo@False conf = do
middleware = logWare . defaultMiddlewaresNoLogging middleware = logWare . defaultMiddlewaresNoLogging
return (middleware app, logFunc) return (middleware app, logFunc)
getDbConf :: AppConfig DefaultEnv Extra -> IO Settings.PersistConf
getDbConf conf =
withYamlEnvironment "config/postgresql.yml" (appEnv conf)
Database.Persist.loadConfig >>=
Database.Persist.applyEnv
loadBlobStore :: Manager -> AppConfig DefaultEnv Extra -> IO (BlobStore StoreKey)
loadBlobStore manager conf =
case storeConfig $ appExtra conf of
BSCFile root -> return $ fileStore root
BSCAWS root access secret bucket prefix -> do
creds <- Aws.Credentials
<$> pure (encodeUtf8 access)
<*> pure (encodeUtf8 secret)
<*> newIORef []
<*> pure Nothing
return $ cachedS3Store root creds bucket prefix manager
-- | Loads up any necessary settings, creates your foundation datatype, and -- | Loads up any necessary settings, creates your foundation datatype, and
-- performs some initialization. -- performs some initialization.
makeFoundation :: Bool -> AppConfig DefaultEnv Extra -> IO App makeFoundation :: Bool -> AppConfig DefaultEnv Extra -> IO App
makeFoundation useEcho conf = do makeFoundation useEcho conf = do
manager <- newManager manager <- newManager
s <- staticSite s <- staticSite
dbconf <- withYamlEnvironment "config/postgresql.yml" (appEnv conf) dbconf <- getDbConf conf
Database.Persist.loadConfig >>= p <- Database.Persist.createPoolConfig dbconf
Database.Persist.applyEnv
p <- Database.Persist.createPoolConfig (dbconf :: Settings.PersistConf)
loggerSet' <- if useEcho loggerSet' <- if useEcho
then newFileLoggerSet defaultBufSize "/dev/null" then newFileLoggerSet defaultBufSize "/dev/null"
@ -130,16 +147,7 @@ makeFoundation useEcho conf = do
progressMap' <- newIORef mempty progressMap' <- newIORef mempty
nextProgressKey' <- newIORef 0 nextProgressKey' <- newIORef 0
blobStore' <- blobStore' <- loadBlobStore manager conf
case storeConfig $ appExtra conf of
BSCFile root -> return $ fileStore root
BSCAWS root access secret bucket prefix -> do
creds <- Aws.Credentials
<$> pure (encodeUtf8 access)
<*> pure (encodeUtf8 secret)
<*> newIORef []
<*> pure Nothing
return $ cachedS3Store root creds bucket prefix manager
let haddockRootDir' = "/tmp/stackage-server-haddocks2" let haddockRootDir' = "/tmp/stackage-server-haddocks2"
(statusRef, unpacker) <- createHaddockUnpacker haddockRootDir' blobStore' (statusRef, unpacker) <- createHaddockUnpacker haddockRootDir' blobStore'
@ -190,6 +198,35 @@ makeFoundation useEcho conf = do
then void m then void m
else return () else return ()
data CabalLoaderEnv = CabalLoaderEnv
{ cleSettings :: !(AppConfig DefaultEnv Extra)
, cleBlobStore :: !(BlobStore StoreKey)
, cleManager :: !Manager
}
instance HasHackageRoot CabalLoaderEnv where
getHackageRoot = hackageRoot . appExtra . cleSettings
instance HasBlobStore CabalLoaderEnv StoreKey where
getBlobStore = cleBlobStore
instance HasHttpManager CabalLoaderEnv where
getHttpManager = cleManager
cabalLoaderMain :: IO ()
cabalLoaderMain = do
conf <- fromArgs parseExtra
dbconf <- getDbConf conf
pool <- Database.Persist.createPoolConfig dbconf
manager <- newManager
bs <- loadBlobStore manager conf
runStdoutLoggingT $ appLoadCabalFiles
CabalLoaderEnv
{ cleSettings = conf
, cleBlobStore = bs
, cleManager = manager
}
dbconf
pool
appLoadCabalFiles :: ( PersistConfig c appLoadCabalFiles :: ( PersistConfig c
, PersistConfigBackend c ~ SqlPersistT , PersistConfigBackend c ~ SqlPersistT
, HasHackageRoot env , HasHackageRoot env

4
app/cabal-loader.hs Normal file
View File

@ -0,0 +1,4 @@
import Application
main :: IO ()
main = cabalLoaderMain

View File

@ -155,6 +155,18 @@ executable stackage-server
ghc-options: -threaded -O2 -rtsopts -with-rtsopts=-N ghc-options: -threaded -O2 -rtsopts -with-rtsopts=-N
executable cabal-loader-stackage
if flag(library-only)
Buildable: False
main-is: cabal-loader.hs
hs-source-dirs: app
build-depends: base
, stackage-server
, yesod
ghc-options: -threaded -O2 -rtsopts -with-rtsopts=-N
test-suite test test-suite test
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
main-is: main.hs main-is: main.hs