Add tazblog-db executable
This commit is contained in:
parent
0f6ff6310e
commit
e9f044e6d5
2 changed files with 45 additions and 0 deletions
34
db/Main.hs
Normal file
34
db/Main.hs
Normal file
|
@ -0,0 +1,34 @@
|
||||||
|
-- | Main module for the database server
|
||||||
|
module Main where
|
||||||
|
|
||||||
|
import BlogDB (initialBlogState)
|
||||||
|
import Control.Applicative (pure, (<$>), (<*>))
|
||||||
|
import Control.Exception (bracket)
|
||||||
|
import Data.Acid
|
||||||
|
import Data.Acid.Local (createCheckpointAndClose)
|
||||||
|
import Data.Acid.Remote
|
||||||
|
import Data.Word
|
||||||
|
import Network (PortID (..))
|
||||||
|
import Options
|
||||||
|
|
||||||
|
data DBOptions = DBOptions {
|
||||||
|
dbPort :: Word16,
|
||||||
|
stateDirectory :: String
|
||||||
|
}
|
||||||
|
|
||||||
|
instance Options DBOptions where
|
||||||
|
defineOptions = pure DBOptions
|
||||||
|
<*> simpleOption "dbport" 8070
|
||||||
|
"Port to serve acid-state on remotely."
|
||||||
|
<*> simpleOption "state" "/var/tazblog/state"
|
||||||
|
"Directory in which the acid-state is located."
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = do
|
||||||
|
putStrLn ("Launching TazBlog database server ...")
|
||||||
|
runCommand $ \opts args ->
|
||||||
|
bracket (openState opts) createCheckpointAndClose
|
||||||
|
(acidServer skipAuthenticationCheck $ getPort opts)
|
||||||
|
where
|
||||||
|
openState o = openLocalStateFrom (stateDirectory o) initialBlogState
|
||||||
|
getPort = PortNumber . fromIntegral . dbPort
|
|
@ -56,3 +56,14 @@ executable tazblog
|
||||||
acid-state,
|
acid-state,
|
||||||
tazblog,
|
tazblog,
|
||||||
options
|
options
|
||||||
|
|
||||||
|
executable tazblog-db
|
||||||
|
hs-source-dirs: db
|
||||||
|
main-is: Main.hs
|
||||||
|
default-language: Haskell2010
|
||||||
|
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||||
|
build-depends: base,
|
||||||
|
acid-state,
|
||||||
|
tazblog,
|
||||||
|
options,
|
||||||
|
network
|
||||||
|
|
Loading…
Reference in a new issue