diff --git a/HPasteIt.hs b/HPasteIt.hs --- a/HPasteIt.hs +++ b/HPasteIt.hs @@ -4,8 +4,11 @@ import ProgOpts (ProgOpts(..), parseOpts) import Control.Applicative +import Control.Monad +import Data.Maybe import System.Directory import System.Environment +import System.FilePath import System.Exit import System.IO @@ -24,16 +27,55 @@ realMain :: ProgOpts -> IO () realMain PasteOpts { optFile = opt_file - , optTitle = opt_title - , optAuthor = opt_author - , optLanguage = opt_language + , optTitle = m_opt_title + , optAuthor = m_opt_author + , optLanguage = m_opt_language , optChannel = opt_channel + , optDebug = opt_debug } = do paste <- case opt_file of "-" -> UTF8.fromString <$> getContents file -> UTF8.fromString <$> readFile file + -- An incomplete map from file extensions to language + let ext_map = [ ("hs" , "haskell" ) + , ("hsc" , "haskell" ) + , ("lhs" , "literatehaskell") + , ("c" , "c" ) + , ("h" , "c" ) + , ("agda", "agda" ) + , ("sh" , "bash" ) + ] + + m_ext = lookup (takeExtension opt_file) ext_map + opt_language = fromMaybe "haskell" (m_opt_language <|> m_ext) + + opt_author <- do + env_author <- try (getEnv "HPASTE_AUTHOR") + + let m_author = case env_author :: Either IOException String of + Right author | not (null author) -> Just author + _otherwise -> Nothing + + return $ fromMaybe "Anonymous" (m_opt_author <|> m_author) + + let def_title = if opt_file /= "-" then takeBaseName opt_file + else "(no title)" + + opt_title = fromMaybe def_title m_opt_title + + when opt_debug $ do + hPutStrLn stderr $ unlines + [ "Title : " ++ show opt_title + , "Author : " ++ show opt_author + , "Language : " ++ show opt_language + , "Channel : " ++ show opt_channel + , "Debug : " ++ show opt_debug + ] + + exitSuccess + res <- withManager $ \man -> try $ do rq <- parseUrl "http://hpaste.org/new" let rq' = urlEncodedBody @@ -100,7 +142,7 @@ editor <- do m_editor <- try (getEnv "EDITOR") - case m_editor :: Either SomeException String of + case m_editor :: Either IOException String of Right editor | not (null editor) -> return editor _otherwise -> do hPutStrLn stderr "$EDITOR not defined. Using 'vi'" diff --git a/ProgOpts.hs b/ProgOpts.hs --- a/ProgOpts.hs +++ b/ProgOpts.hs @@ -12,18 +12,27 @@ import Options.Applicative import Safe -data ProgOpts = PasteOpts { optTitle :: String - , optAuthor :: String - , optLanguage :: String +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 = subparser $ mconcat - [ command "paste" (info optPasteParser (infoMod <> progDesc "paste something")) - , command "view" (info optViewParser (infoMod <> progDesc "view a paste")) +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 @@ -54,30 +63,33 @@ optPasteParser :: Parser ProgOpts optPasteParser = PasteOpts - <$> nullOption (mconcat [ reader Right - , value "(no title)" - , showDefault + <$> 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 - , value "Anonymous" - , showDefault + <*> 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 (readLanguage . map toLower) + <*> nullOption (mconcat [ reader (fmap Just . readLanguage . map toLower) , long "language" , short 'l' , metavar "LANGUAGE" - , value "haskell" - , showDefault + , value Nothing + , showDefaultWith $ \_ -> + "inferred by file name else Haskell" , help "The language of the paste" ]) @@ -90,24 +102,29 @@ , help "The IRC channel to notify" ]) + <*> switch (mconcat [ metavar "DEBUG" + , 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" + , 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 - | 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" @@ -117,13 +134,17 @@ ++ "supported languages." readChannel :: String -> Either ParseError String - readChannel chan - = if dropWhile (=='#') chan `elem` chans - then Right chan - else Left (ErrorMsg err_msg) + 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"] + chans = ["#haskell"] err_msg = "Invalid IRC channel. See hpaste.org for a full list of " ++ "valid IRC channels." @@ -138,5 +159,7 @@ $ info (helper <*> optParser) $ mconcat [ infoMod , footer $ "Append --help after a command to see detailed " - ++ "usage information" + ++ "usage information\n" + ++ "By default, the command is 'paste'\n" + ++ "Define $HPASTE_AUTHOR to set a default author." ] diff --git a/hpasteit.cabal b/hpasteit.cabal --- a/hpasteit.cabal +++ b/hpasteit.cabal @@ -1,5 +1,5 @@ name: hpasteit -version: 0.2.4.0 +version: 0.3.0.0 synopsis: A command-line client for hpaste.org license: BSD3 license-file: LICENSE @@ -18,7 +18,23 @@ . Run @hpasteit --help@ for usage information and @hpasteit COMMAND --help@ for detailed usage information about a particular command. + . + + Changes in 0.3.0.0 + . + * 'paste' is now the default command, so you can upload a paste by simply doing + @hpasteit mypaste.hs@ + . + * hpasteit now infers the title and language of the paste + . + * hpasteit now reads from @\$HPASTE_AUTHOR@ to set the author if no author + is explicitly provided + . + * channels can be inputted without the leading hash-bangs + + . + Changes in 0.2.4.0 . * made the program unicode-aware @@ -44,6 +60,7 @@ , directory ==1.2.* , safe ==0.3.* , utf8-string ==0.3.* + , filepath ==1.3.* ghc-options: -Wall