blob: e82d8381d9507b9e6a5990d1662e60323a86786f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
module Main (main) where
import qualified Cache
import Control.Concurrent (forkIO)
import qualified Http
import Intro
import qualified Queue as Q
import qualified Smtp
import System.Environment (getArgs)
data Opts = Opts {httpPort :: String, smtpPort :: String} deriving (Show)
defaultHttpPort :: String
defaultHttpPort = "9785"
defaultSmtpPort :: String
defaultSmtpPort = "5879"
main :: IO ()
main = do
args <- getArgs
case (parseArgs args) of
Right opts -> do
putStrLn $ "Starting HTTP server at http://localhost:" ++ opts.httpPort
putStrLn $ "Starting SMTP server at smtp://localhost:" ++ opts.smtpPort
queue <- Q.newQueue
cache <- Cache.newInMemory
_ <- forkIO $ Cache.start queue cache
_ <- forkIO $ Http.runServer Nothing opts.httpPort cache queue
Smtp.runServer Nothing opts.smtpPort queue
Left err -> putStrLn ("Error. " ++ err)
parseArgs :: [String] -> Either String Opts
parseArgs args = parse args (Opts defaultHttpPort defaultSmtpPort)
where
parse [] opts = Right opts
parse (x1 : x2 : xs) opts
| x1 == "-http-port" = parse xs (opts{httpPort = x2})
| x1 == "-smtp-port" = parse xs (opts{smtpPort = x2})
parse (x : []) _
| x == "-http-port" = Left "Missing HTTP port"
| x == "-smtp-port" = Left "Missing SMTP port"
parse (x : _) _ = Left ("Unrecognized option: " ++ x)
|
