hpasteit-0.2.4.0: 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     :: String
                          , optAuthor    :: String
                          , optLanguage  :: String
                          , optChannel   :: String
                          , optFile      :: FilePath
                          }
              | ViewOpts  { optPasteID   :: Integer }

optParser :: Parser ProgOpts
optParser = subparser $ mconcat
    [ command "paste" (info optPasteParser (infoMod <> progDesc "paste something"))
    , command "view"  (info optViewParser  (infoMod <> progDesc "view a paste"))
    ]

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
                                , value   "(no title)"
                                , showDefault
                                , short   't'
                                , long    "title"
                                , metavar "TITLE"
                                , help    "The title of the paste"
                                ])

        <*> nullOption (mconcat [ reader  Right
                                , value   "Anonymous"
                                , showDefault
                                , short   'a'
                                , long    "author"
                                , metavar "AUTHOR"
                                , help    "The author of the paste"
                                ])

        <*> nullOption (mconcat [ reader  (readLanguage . map toLower)
                                , long    "language"
                                , short   'l'
                                , metavar "LANGUAGE"
                                , value   "haskell"
                                , showDefault
                                , 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"
                                ])

        <*> argument Just (mconcat [ metavar "FILE"
                                   , value   "-"
                                   , showDefault
                                   , help    "The path of the file to paste"
                                   ])
  where
    -- The string arguments of these functions are (assumed to be) lower-case.

    readLanguage :: String -> Either ParseError String
    readLanguage lang
      | Just real_lang <- lookup lang suffixes = Right real_lang
      | lang `elem` langs = Right lang
      | otherwise         = Left (ErrorMsg err_msg)
      where
        suffixes = [ ("hs" , "haskell"        )
                   , ("lhs", "literatehaskell")
                   ]

        -- 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
        = if dropWhile (=='#') chan `elem` chans
            then Right chan
            else Left (ErrorMsg err_msg)
      where
        -- 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"
                    ]