ws-0.0.2: app/Main.hs

{-# LANGUAGE
    ScopedTypeVariables
  , FlexibleContexts
  #-}

module Main where

import App (app)
import App.Types (Env (Env, envHost, envPort, envPath, envSecure), runAppM, handleInitException, InitException (NoURIAuthority, URIParseException))
import Options.Applicative (Parser, strArgument, ParserInfo, metavar, help, fullDesc, progDesc, header, helper, info, execParser)
import Network.URI (parseURI, uriAuthority, uriRegName, uriUserInfo, uriScheme, uriPath, uriPort)

import Data.Monoid ((<>))
import Control.Monad.Catch (throwM, handle)
import Control.Applicative (optional)


-- * Options Parsing

-- | Application-wide options
newtype AppOpts = AppOpts
  { url :: Maybe String
  }

-- | Options for each field
appOpts :: Parser AppOpts
appOpts =
  AppOpts <$> urlOpt
  where
    urlOpt :: Parser (Maybe String)
    urlOpt = optional $ strArgument $
         metavar "TARGET"
      <> help "The websocket address to connect to - example:\
                \ `ws://localhost:3000/foo`"


-- | Options for entire app
opts :: ParserInfo AppOpts
opts = info (helper <*> appOpts) $
    fullDesc
 <> progDesc "Connect to a websocket"
 <> header "ws - a CLI websocket tool"



-- * Executable

main :: IO ()
main = do
  env <- handle handleInitException
       $ appOptsToEnv =<< execParser opts

  runAppM env app



-- | Translate the CLI parsed options to a sane type we can use in our app
appOptsToEnv :: AppOpts -> IO Env
appOptsToEnv (AppOpts mu) = do
  u <- case mu of
    Nothing -> do
      putStrLn "Websocket URI: "
      getLine
    Just x -> pure x
  case parseURI u of
    Nothing -> throwM $ URIParseException u
    Just u' ->
      case uriAuthority u' of
        Nothing -> throwM $ NoURIAuthority u
        Just a ->
          let host = uriUserInfo a
                  ++ uriRegName a
              port = fromIntegral $
                let ps = drop 1 (uriPort a)
                in if ps /= ""
                then read ps
                else if uriScheme u' == "wss:"
                then 443 :: Int
                else 80
              path' =
                let p = uriPath u'
                in if p == ""
                then "/"
                else p
          in  pure Env { envHost   = host
                       , envPort   = port
                       , envPath   = path'
                       , envSecure = uriScheme u' == "wss:"
                       }