diff --git a/shift.cabal b/shift.cabal index 95eab874be02e74a75112a89e3e844ef08d5f516..990a59770a0392c0814948a6a9a9baabdc86baae 100644 --- a/shift.cabal +++ b/shift.cabal @@ -21,6 +21,7 @@ library , Shift.Parsers , Shift.Processing , Shift.Rendering + , Shift.Server , Shift.Types , Shift.Utilities , GitHub.UserSearch @@ -48,6 +49,7 @@ library , exceptions , semigroups , cmark-gfm + , scotty default-language: Haskell2010 executable shift diff --git a/src/Shift.hs b/src/Shift.hs index ef1cc1f56353cbd06614c63660228db520f559fb..013fb94f11393c69f112c52515cea33c812220bf 100644 --- a/src/Shift.hs +++ b/src/Shift.hs @@ -11,6 +11,7 @@ import Shift.CLI as X import Shift.Git as X import Shift.Rendering as X import Shift.Types as X +import Shift.Server (runServer) -- | The main CLI entrypoint. shiftMain :: IO () @@ -19,6 +20,7 @@ shiftMain = do case currentOptions ^. soCommand of GenerateCommand -> tempMain currentOptions + ServeCommand -> runServer currentOptions where opts = info (helper <*> shiftOptions) diff --git a/src/Shift/CLI.hs b/src/Shift/CLI.hs index 39cc42f3da88be9c5ea9ee5432f8080647d62827..f4193c915996c2312e1be9c141827eb0f5442cf7 100644 --- a/src/Shift/CLI.hs +++ b/src/Shift/CLI.hs @@ -1,56 +1,70 @@ -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell #-} module Shift.CLI where -import Options.Applicative - import Control.Lens (makeLenses) +import Options.Applicative data ShiftOptions = ShiftOptions - { _soCommand :: ShiftCommand - , _soHostingType :: HostingType - , _soGitHubOwner :: Maybe String - , _soGitHubRepository :: Maybe String - , _soGitHubToken :: Maybe String - } deriving (Show, Eq) + { _soCommand :: ShiftCommand, + _soHostingType :: HostingType, + _soGitHubOwner :: Maybe String, + _soGitHubRepository :: Maybe String, + _soGitHubToken :: Maybe String + } + deriving (Show, Eq) -data ShiftCommand = GenerateCommand deriving (Show, Eq, Enum) +data ShiftCommand = GenerateCommand | ServeCommand deriving (Show, Eq, Enum) data HostingType = GitHubType | GitType deriving (Show, Eq, Enum) shiftOptions :: Parser ShiftOptions -shiftOptions = ShiftOptions - <$> shiftCommand - <*> option hostingType - ( long "hosting-type" - <> short 't' - <> metavar "TYPE" - <> help "Which kind of service the repository is hosted on" - ) - <*> optional (strOption - ( long "github-owner" - <> metavar "USERNAME" - <> help "Username who owns the repository" - )) - <*> optional (strOption - ( long "github-repository" - <> metavar "REPOSITORY" - <> help "Name of the repository" - )) - <*> optional (strOption - ( long "github-token" - <> metavar "TOKEN" - <> help "GitHub access token" - )) +shiftOptions = + ShiftOptions + <$> shiftCommand + <*> option + hostingType + ( long "hosting-type" + <> short 't' + <> metavar "TYPE" + <> help "Which kind of service the repository is hosted on" + ) + <*> optional + ( strOption + ( long "github-owner" + <> metavar "USERNAME" + <> help "Username who owns the repository" + ) + ) + <*> optional + ( strOption + ( long "github-repository" + <> metavar "REPOSITORY" + <> help "Name of the repository" + ) + ) + <*> optional + ( strOption + ( long "github-token" + <> metavar "TOKEN" + <> help "GitHub access token" + ) + ) shiftCommand :: Parser ShiftCommand -shiftCommand = subparser $ - command "generate" - (info (pure GenerateCommand) - (progDesc "Generate changelog") - ) +shiftCommand = + subparser $ + command + "generate" + ( info + (pure GenerateCommand) + (progDesc "Generate changelog") + ) + <> command + "serve" + (info (pure ServeCommand) (progDesc "Start UI server")) hostingType :: ReadM HostingType hostingType = eitherReader $ \case diff --git a/src/Shift/Server.hs b/src/Shift/Server.hs new file mode 100644 index 0000000000000000000000000000000000000000..0e69ee400e0ad33b1bb910e535d125cfe60b28e8 --- /dev/null +++ b/src/Shift/Server.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Shift.Server (runServer) where + +import Web.Scotty (scotty, get, param, html) +import Shift.CLI (ShiftOptions) +import Shift.Git (renderToNode) +import Control.Monad.IO.Class (MonadIO(liftIO)) +import CMarkGFM (nodeToHtml, nodeToHtml, commonmarkToHtml) +import Data.Text.Lazy (fromChunks) + +runServer :: ShiftOptions -> IO () +runServer options = scotty 3000 $ + get "/" $ do + node <- liftIO $ renderToNode options + html $ fromChunks [nodeToHtml [] [] node]