1. Doug Burke
  2. astrosearch

Source

astrosearch / AstroServer.hs

{-# LANGUAGE OverloadedStrings #-}

{-

Usage:

  ./astroserver <port> <term1> [... <termn>]

Aim:

If the search term does not match the existing search term then the server will
fail to start.
-}

module Main (main) where

import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Text.IO as T

import Data.Acid
import Data.Acid.Remote (acidServer)
import Data.Acid.Local (createCheckpointAndClose)

import Control.Exception (bracket)
import Control.Monad (forM_)

import Network

import System.Environment (getProgName, getArgs)
import System.Exit (exitFailure)

import AcidState

usage :: IO ()
usage = do
  progName <- getProgName
  putStrLn $ "Usage: " ++ progName ++ " <port number> <search term1> .. <termn>"
  exitFailure
  
combineTerms :: S.Set T.Text -> T.Text
combineTerms = T.intercalate "," . S.toList

-- bracket from Control.Exception does catch exitFailure, so
-- the check point will be created even if the search terms fail;
-- this is excessive but hopefully a rare event.
--
startServer :: PortNumber -> [String] -> IO ()  
startServer port terms = 
    let s1 = S.fromList $ map (T.toLower . T.pack) terms
    in bracket
           (openLocalStateFrom "tweetstore/" (emptyTweetStore s1))
           createCheckpointAndClose
           (\acid -> do
              s2 <- query acid GetSearchTerms
              if s1 /= s2
                then do
                  T.putStrLn $ T.concat 
		  	     [ "ERROR: server is for search="
                             , combineTerms s2
			     , " not "
			     , combineTerms s1
			     ]
                  exitFailure
                else do
                  forM_ (S.toList s2) $ T.putStrLn . ("Search term: " `T.append`)
                  acidServer acid (PortNumber port)
           )  
      
main :: IO ()
main = do
  args <- getArgs
  case args of
    [_] -> usage

    (port:terms) -> case getPort port of
      Just p -> putStrLn ("Starting server on port " ++ port) 
                >> startServer p terms
      _ -> usage
      
    _ -> usage