hpasteit-0.3.1: ProgOpts.hs

module ProgOpts
    ( ProgOpts(..)
    , parseOpts
    ) where

import Control.Monad
import Data.Char
import Data.List
import Data.Monoid

import Network.URI
import Options.Applicative
import Safe

data ProgOpts = PasteOpts { optTitle     :: Maybe String
                          , optAuthor    :: Maybe String
                          , optLanguage  :: Maybe String
                          , optChannel   :: String
                          , optDebug     :: Bool
                          , optFile      :: FilePath
                          }
              | ViewOpts  { optPasteID   :: Integer }

optParser :: Parser ProgOpts
optParser = foldr (<|>) empty
    [ subparser $ mconcat

        [ command "paste" $ info (helper <*> optPasteParser)
                          $ infoMod <> progDesc "paste something"

        , command "view"  $ info (helper <*> optViewParser)
                          $ infoMod <> progDesc "view a paste"
        ]

    , optPasteParser
    ]

optViewParser :: Parser ProgOpts
optViewParser = ViewOpts
        <$> argument parsePasteID (mconcat [ metavar "PASTEID"
                                           , help pasteIDHelp
                                           ])
  where
    pasteIDHelp = "The URL or the ID number of the paste you want to view"

    parsePasteID :: String -> Maybe Integer
    parsePasteID input = readMay input <|> parsePasteUri input

    parsePasteUri :: String -> Maybe Integer
    parsePasteUri input = do
        URI { uriAuthority = uri_authority
            , uriPath      = '/':uri_path  } <- parseURI input'

        URIAuth { uriRegName = "hpaste.org" } <- uri_authority

        paste_id <- readMay uri_path
        guard (paste_id > 0)
        return paste_id
      where
        input' = if "http://" `isPrefixOf` input
                    then input
                    else "http://" ++ input

optPasteParser :: Parser ProgOpts
optPasteParser = PasteOpts
        <$> nullOption (mconcat [ reader  (Right . Just)
                                , value   Nothing
                                , showDefaultWith $ \_ ->
                                    "inferred by file name else (no title)"
                                , short   't'
                                , long    "title"
                                , metavar "TITLE"
                                , help    "The title of the paste"
                                ])

        <*> nullOption (mconcat [ reader  (Right . Just)
                                , value   Nothing
                                , showDefaultWith $ \_ ->
                                    "defined by $HPASTE_AUTHOR else Anonymous"
                                , short   'a'
                                , long    "author"
                                , metavar "AUTHOR"
                                , help    "The author of the paste"
                                ])

        <*> nullOption (mconcat [ reader  (fmap Just . readLanguage . map toLower)
                                , long    "language"
                                , short   'l'
                                , metavar "LANGUAGE"
                                , value   Nothing
                                , showDefaultWith $ \_ ->
                                    "inferred by file name else Haskell"
                                , help    "The language of the paste"
                                ])

        <*> nullOption (mconcat [ reader  (readChannel . map toLower)
                                , long    "channel"
                                , short   'c'
                                , metavar "CHANNEL"
                                , value   ""
                                , showDefault
                                , help    "The IRC channel to notify"
                                ])

        <*> switch (mconcat [ value False
                            , long "debug"
                            , short 'd'
                            , showDefault
                            , help "Just print debug info"
                            ])

        <*> argument Just (mconcat [ metavar "FILE"
                                   , value   "-"
                                   , showDefault
                                   , help  $ "The path of the file to paste "
                                          ++ "(use - for STDIN)"
                                   ])

  where
    -- The string arguments of these functions are (assumed to be) lower-case.

    readLanguage :: String -> Either ParseError String
    readLanguage lang
      | lang `elem` langs = Right lang
      | otherwise         = Left (ErrorMsg err_msg)
      where
        -- Not an exhaustive list.
        langs = ["haskell","agda","ocaml","lisp","erlang","literatehaskell"
                ,"c","cpp"
                ]

        err_msg = "Invalid language. See hpaste.org for a full list of "
               ++ "supported languages."

    readChannel :: String -> Either ParseError String
    readChannel chan = case trimBangs chan `elemIndex` map trimBangs chans of
        -- Let the user input a channel without the leading #s but
        -- fix the input so that it is a valid channel.
        Just idx -> Right (chans !! idx)

        Nothing  -> Left (ErrorMsg err_msg)
      where
        trimBangs = dropWhile (=='#')

        -- Not an exhaustive list.
        chans = ["#haskell"]

        err_msg = "Invalid IRC channel. See hpaste.org for a full list of "
               ++ "valid IRC channels."

infoMod :: InfoMod ProgOpts
infoMod = mconcat [ fullDesc
                  , header "hpasteit - command-line client for hpaste.org"
                  ]

parseOpts :: IO ProgOpts
parseOpts = customExecParser (prefs showHelpOnError)
          $ info (helper <*> optParser)
          $ mconcat [ infoMod
                    , footer $ "Append --help after a command to see detailed "
                            ++ "usage information\n"
                            ++ "By default, the command is 'paste'\n"
                            ++ "Define $HPASTE_AUTHOR to set a default author."
                    ]