Launch.hs

{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE ViewPatterns          #-}

module Yu.Launch
       ( createXiao
       , warp
       , module Yu.Launch.Internal
       ) where

import           System.IO
import           Yesod.Core.Dispatch
import           Yu.Core.Control
import           Yu.Core.Model
import qualified Yu.Import.Text      as T
import           Yu.Launch.Internal


mkYesodDispatch "Xiao" resourcesXiao

createXiao :: [XiaoConfig]
           -> IO (Maybe Xiao)
createXiao rcs = do
  case (filter rainConfigIsServer rcs, filter (not.rainConfigIsServer) rcs) of
    (RCServer{..}:_,RCDatabase{..}:_) -> do
      cp <- createPool (connect $ readHostPort rcdDBAddr) close 10 20 1000
      return $ Just $ Xiao { rainTitle    = rcsTitle
                           , rainDb       = rcdDB
                           , rainDBUP     = (T.pack rcdUser,T.pack rcdPass)
                           , rainConnPool = cp
                           , rainPort     = rcsPort
                           }
    _ -> do
      hPutStrLn stderr "invaild config"
      return Nothing