hablog 0.4.1 → 0.5.0
raw patch · 3 files changed
+81/−48 lines, 3 filesdep +optparse-applicativePVP ok
version bump matches the API change (PVP)
Dependencies added: optparse-applicative
API changes (from Hackage documentation)
+ Web.Hablog.Config: instance GHC.Show.Show Web.Hablog.Config.Config
+ Web.Hablog.Config: instance GHC.Show.Show Web.Hablog.Config.TLSConfig
+ Web.Hablog.Config: instance GHC.Show.Show Web.Hablog.Config.Theme
Files
- app/Main.hs +74/−47
- hablog.cabal +2/−1
- src/Web/Hablog/Config.hs +5/−0
app/Main.hs view
@@ -6,62 +6,89 @@ import Control.Monad (void) import Control.Concurrent (forkIO)-import System.Environment (getArgs)+import Data.List (intercalate)+import Options.Applicative import Web.Hablog main :: IO ()-main =- getArgs >>= \case- [] ->- run defaultConfig defaultPort+main = do+ args <- execParser paramsParserInfo+ let cfg = defaultConfig { blogTheme = pTheme args }+ case pCfg args of+ HTTP port ->+ run cfg port+ HTTPS tlsCfg ->+ runTLS tlsCfg cfg+ Both port tlsCfg -> do+ void $ forkIO $ run cfg port+ runTLS tlsCfg cfg - ["both", portStr, tlsPortStr, key, cert] ->- case (reads portStr, reads tlsPortStr) of- ([(port, "")], [(tlsPort, "")]) -> do- void $ forkIO $ run defaultConfig port- runTLS- TLSConfig { blogTLSPort = tlsPort, blogKey = key, blogCert = cert }- defaultConfig- _ ->- putStrLn usageMsgBoth- ["tls", portStr, key, cert] ->- case reads portStr of- [(port, "")] ->- runTLS- TLSConfig { blogTLSPort = port, blogKey = key, blogCert = cert }- defaultConfig- _ ->- putStrLn usageMsgTLS+--------------------+-- Options Parser+-------------------- - [themeStr]- | Just theme <- lookup themeStr themes ->- run defaultConfig { blogTheme = theme } defaultPort+data Params = Params+ { pTheme :: Theme+ , pCfg :: Command+ }+ deriving Show - [portStr]- | [(port, "")] <- reads portStr ->- run defaultConfig port+data Command+ = HTTP Int+ | HTTPS TLSConfig+ | Both Int TLSConfig+ deriving Show - [themeStr,portStr]- | Just theme <- lookup themeStr themes- , [(port, "")] <- reads portStr ->- run defaultConfig { blogTheme = theme } port+paramsParserInfo :: ParserInfo Params+paramsParserInfo =+ info (helper <*> (Params <$> fmap snd thm <*> cmd)) $+ fullDesc+ <> header "Hablog - A blogging System" - _ ->- putStrLn usageMsg+thm :: Parser (String, Theme)+thm =+ option (str >>= readTheme)+ (long "theme"+ <> short 't'+ <> metavar "THEME"+ <> help "Select a blog theme"+ <> showDefaultWith fst+ <> value ("dark", darkTheme)+ ) -usageMsg :: String-usageMsg =- unlines- [ "Usage: hablog <port>"- , "or"- , usageMsgTLS- , "or"- , usageMsgBoth- ]+readTheme :: String -> ReadM (String, Theme)+readTheme themeStr =+ case lookup themeStr themes of+ Just tm -> pure (themeStr, tm)+ Nothing ->+ readerError $+ "'" ++ themeStr ++ "' is not a valid theme. Try one of: "+ ++ intercalate ", " (map fst themes) -usageMsgTLS :: String-usageMsgTLS = "Usage: hablog tls <port> <key file> <cert file>"+cmd :: Parser Command+cmd =+ subparser+ ( command "http" (info (HTTP <$> httpConfig <**> helper)+ ( progDesc "Run only in HTTP mode" ))+ <> command "https" (info (HTTPS <$> tlsConfig <**> helper)+ ( progDesc "Run only in TLS mode" ))+ <> command "both" (info (Both <$> httpConfig <*> tlsConfig <**> helper)+ ( progDesc "Run both in HTTP and TLS modes" ))+ ) -usageMsgBoth :: String-usageMsgBoth = "Usage: hablog both <port> <port tls> <key file> <cert file>"+httpConfig :: Parser Int+httpConfig =+ option auto+ (long "port"+ <> short 'p'+ <> metavar "PORT"+ <> help "Port for HTTP"+ <> showDefault+ <> value 80+ ) +tlsConfig :: Parser TLSConfig+tlsConfig = TLSConfig+ <$> option auto (long "tls-port" <> short 'P' <> metavar "PORT" <> help "Port for TLS" <> showDefault <> value 443)+ <*> strOption (long "tls-key" <> short 'k' <> metavar "KEY" <> help "Key file for for TLS")+ <*> strOption (long "tls-cert" <> short 'c' <> metavar "CERT" <> help "Cert file for for TLS")
hablog.cabal view
@@ -1,5 +1,5 @@ Name: hablog-Version: 0.4.1+Version: 0.5.0 Synopsis: A blog system Description: blog system with tags License: MIT@@ -78,6 +78,7 @@ Build-depends: base+ ,optparse-applicative ,hablog default-language:
src/Web/Hablog/Config.hs view
@@ -13,11 +13,15 @@ , codeTheme :: AttributeValue -- ^ Theme for code. a file path for a highlight.js css file } +instance Show Theme where+ show _ = "<Theme>"+ -- | Configuration for Hablog data Config = Config { blogTitle :: Text , blogTheme :: Theme }+ deriving Show -- | Requires the needed values for runTLS data TLSConfig = TLSConfig@@ -25,6 +29,7 @@ , blogCert :: FilePath , blogKey :: FilePath }+ deriving Show -- | A default configuration defaultConfig :: Config