packages feed

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 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