yu-launch 0.1.0.0 → 0.1.0.6

raw patch · 4 files changed

+62/−50 lines, 4 files

Files

• src/Main.hs +17/−7
• src/Yu/Launch.hs +15/−15
• src/Yu/Launch/Internal.hs +29/−27
• yu-launch.cabal +1/−1

@@ -14,20 +14,30 @@ import qualified Yu.Import.ByteString.Lazy as BL import qualified Yu.Import.Text            as T import           Yu.Launch+import Paths_yu_launch   main :: IO () main = do-  rain <- createXiao =<< parseCfgFile <$> getContents-  case rain of-    Just r@Xiao{..} -> warp rainPort r+  xiao <- createXiao =<< parseCfgFile <$> fetchConfig+  case xiao of+    Just x@Xiao{..} -> warp xiaoPort x     _               -> hPutStrLn stderr "can not parse"   return ()  -parseCfgFileJSON :: String -> Maybe [XiaoConfig]+fetchConfig :: IO String+fetchConfig = do+  cfg1 <- getContents+  etcP <- getSysconfDir+  if null cfg1+    then readFile $ etcP ++ "/xiao/config"+    else return cfg1+++parseCfgFileJSON :: String -> Maybe XiaoConfigServer parseCfgFileJSON str = A.decode $ BL.pack str-parseCfgFileYAML :: String -> Maybe [XiaoConfig]+parseCfgFileYAML :: String -> Maybe XiaoConfigServer parseCfgFileYAML str = Y.decode $  B.pack str-parseCfgFile :: String ->  [XiaoConfig]-parseCfgFile str =  fromMaybe [] $ parseCfgFileYAML str <|> parseCfgFileJSON str+parseCfgFile :: String -> Maybe XiaoConfigServer+parseCfgFile str =  parseCfgFileYAML str <|> parseCfgFileJSON str

@@ -17,25 +17,25 @@ import           Yesod.Core.Dispatch import           Yu.Core.Control import           Yu.Core.Model-import qualified Yu.Import.Text      as T+import qualified Yu.Import.ByteString      as B+import qualified Yu.Import.Text            as T import           Yu.Launch.Internal   mkYesodDispatch "Xiao" resourcesXiao -createXiao :: [XiaoConfig]+createXiao :: Maybe XiaoConfigServer            -> 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+createXiao Nothing   = return Nothing+createXiao (Just xc) = do+  let XCS{..} = xc+      XCD{..} = xcsDB+  cp <- createPool (connect $ readHostPort xcdHost) close 10 20 1000+  return $ Just $ Xiao { xiaoTitle    = xcsTitle+                       , xiaoDb       = xcdName+                       , xiaoDBUP     = (T.pack xcdUser,T.pack xcdPass)+                       , xiaoConnPool = cp+                       , xiaoPort     = xcsPort+                       , xiaoKey      = B.pack xcsKey+                       } 

@@ -9,10 +9,10 @@  module Yu.Launch.Internal        ( Xiao(..)-       , XiaoConfig(..)+       , XiaoConfigServer(..)+       , XiaoConfigDatabase(..)        , Route(..)        , resourcesXiao-       , rainConfigIsServer        ) where  import           Control.Monad.IO.Class@@ -39,28 +39,30 @@   -- | basic config-data XiaoConfig = RCServer-                  { rcsPort  :: Int-                  , rcsTitle :: T.Text-                  }-                | RCDatabase-                  { rcdDB     :: T.Text-                  , rcdDBAddr :: String-                  , rcdUser   :: String-                  , rcdPass   :: String-                  }-                  deriving (Show,Eq)-deriveJSON defaultOptions ''XiaoConfig-rainConfigIsServer :: XiaoConfig -> Bool-rainConfigIsServer RCServer{..}   = True-rainConfigIsServer RCDatabase{..} = False+data XiaoConfigServer = XCS+  { xcsPort  :: Int+  , xcsTitle :: T.Text+  , xcsKey   :: String+  , xcsDB    :: XiaoConfigDatabase+  }+  deriving (Show,Eq)+data XiaoConfigDatabase = XCD+  { xcdName :: T.Text+  , xcdHost :: String+  , xcdUser :: String+  , xcdPass :: String+  }+  deriving (Show,Eq) +deriveJSON defaultOptions {fieldLabelModifier = map toLower . drop 3 } ''XiaoConfigServer+deriveJSON defaultOptions {fieldLabelModifier = map toLower . drop 3} ''XiaoConfigDatabase -data Xiao = Xiao { rainTitle    :: T.Text-                 , rainDb       :: T.Text-                 , rainDBUP     :: (T.Text, T.Text)-                 , rainConnPool :: ConnectionPool-                 , rainPort     :: Int+data Xiao = Xiao { xiaoTitle    :: T.Text+                 , xiaoDb       :: T.Text+                 , xiaoDBUP     :: (T.Text, T.Text)+                 , xiaoConnPool :: ConnectionPool+                 , xiaoPort     :: Int+                 , xiaoKey      :: B.ByteString                  }  mkYesodData "Xiao" [parseRoutes| /*Texts UrlR GET PUT DELETE |]@@ -80,19 +82,19 @@   maximumContentLength _ _ = Nothing  instance Auth Xiao SHA256 where-  tokenItem _ = liftIO $ B.pack <$> getEnv "RAIN_ENV"+  tokenItem x = return $ xiaoKey x   tokenHash _ = return SHA256  instance Hamletic Xiao (HandlerT Xiao IO) where-  getTitle = rainTitle <$> getYesod+  getTitle = xiaoTitle <$> getYesod   getFramePrefix = return ".frame"   getVersion = return $(stringE (show version))   getRaw = return False  instance Mongodic Xiao (HandlerT Xiao IO) where   getDefaultAccessMode = return master-  getDefaultDb = rainDb <$> getYesod-  getDbUP = rainDBUP <$> getYesod-  getPool = rainConnPool <$> getYesod+  getDefaultDb = xiaoDb <$> getYesod+  getDbUP = xiaoDBUP <$> getYesod+  getPool = xiaoConnPool <$> getYesod  instance Controly Xiao

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                yu-launch-version:             0.1.0.0+version:             0.1.0.6 synopsis:            The launcher for Yu. description:         The launcher for Yu. homepage:            https://github.com/Qinka/Yu