haste (empty) → 0.1

raw patch · 15 files changed

+505/−0 lines, 15 filesdep +basedep +curldep +filepathsetup-changed

Dependencies added: base, curl, filepath, mtl

Files

• LICENSE +23/−0
• Setup.hs +3/−0
• haste.cabal +30/−0
• src/Haste/LanguageDetection.hs +26/−0
• src/Haste/Monad.hs +14/−0
• src/Haste/Options.hs +90/−0
• src/Haste/PasteProviders.hs +16/−0
• src/Haste/PasteProviders/All.hs +18/−0
• src/Haste/PasteProviders/Console.hs +18/−0
• src/Haste/PasteProviders/HPaste.hs +34/−0
• src/Haste/PasteProviders/Paste2.hs +32/−0
• src/Haste/PasteProviders/Pastebin.hs +30/−0
• src/Haste/Post.hs +31/−0
• src/Haste/Types.hs +72/−0
• src/Main.hs +68/−0

@@ -0,0 +1,23 @@+Copyright (c) 2009 David Siegel++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.+

@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain

@@ -0,0 +1,30 @@+Name:                haste+Version:             0.1+Description:         A universal pastebin tool, written in Haskell.+category:            Web+synopsis:            A universal pastebin tool, written in Haskell.+License:             BSD3+License-file:        LICENSE+Author:              David Siegel+Maintainer:          djsiegel@gmail.com+Build-Type:          Simple+Cabal-Version:       >=1.4++Executable:          haste+Main-is:             Main.hs+Build-Depends:       base >= 3 && < 4, filepath, mtl, curl+hs-source-dirs:      src+extensions:          ViewPatterns+ghc-options:         -Wall++other-modules:       Haste.LanguageDetection+                     Haste.Monad+										 Haste.Options+										 Haste.PasteProviders+										 Haste.PasteProviders.All+										 Haste.PasteProviders.Console+										 Haste.PasteProviders.HPaste+										 Haste.PasteProviders.Paste2+										 Haste.PasteProviders.Pastebin+										 Haste.Post+                     Haste.Types

@@ -0,0 +1,26 @@+module Haste.LanguageDetection +  ( fromFilePath+  , preferredProviders+  ) where++import qualified System.FilePath.Posix as FilePath++import Haste.Types+import Haste.PasteProviders.All (pasteProviders)++fromFilePath :: FilePath -> Maybe Language+fromFilePath file = lookup (takeExtension file) extensionMap++preferredProviders :: Language -> [SomePasteProvider]+preferredProviders l = filter (elem l . preferredLanguages) pasteProviders++-- Extension sans leading '.'+takeExtension fp = case FilePath.takeExtension fp of+                    '.' : ext -> ext+                    ext       -> ext++extensionMap =+  [ ("hs", Haskell)+  , ("c", C)+  , ("h", C)+  ]

@@ -0,0 +1,14 @@+module Haste.Monad+  ( runHaste+  , liftIO+  , ask, asks+  , module Haste.Types+  ) where++import Haste.Types++import Control.Monad.Trans (liftIO)+import Control.Monad.Reader (ask, asks, runReaderT)++runHaste :: HasteEnvironment -> HM a -> IO a+runHaste env hm = runReaderT hm env

@@ -0,0 +1,90 @@+-----------------------------------------------------------------------------+---- |+---- Module      : Haste.Options+---- Copyright   : David Siegel+---- License     : BSD3-style (see LICENSE)+---- +---- Maintainer  : David Siegel <djsiegel@gmail.com>+---- Stability   : experimental+---- Portability : ?+----+---- Command-line options parsing.+-------------------------------------------------------------------------------++module Haste.Options+  ( getOptions            -- :: Args -> (HasteOptions, Args)+  , helpText              -- :: String+  ) where++import Data.List (sort)++import Haste.Types+import Haste.PasteProviders (lookupProvider, pasteProviders)++import Text.Printf (printf)+import System.Console.GetOpt++-- | Default 'HasteOptions'+defaultOptions :: HasteOptions+defaultOptions = +  HasteOptions+    { optProvider = Nothing+    , optLanguage = Nothing+    , optHelp = False+    }++-- | Help text for options.+helpText :: String+helpText = usageInfo "haste options:" options++options :: [OptDescr (HasteOptions -> HasteOptions)]+options =+  [ Option "h" ["help"]+      (NoArg (\os -> os { optHelp = True }))+      helpOptionInfo++  , Option "p" ["provider"]+      (ReqArg (\p os -> os { optProvider = (Just . readProvider) p }) "PROVIDER")+      providerOptionInfo++  , Option "l" ["language"]+      (ReqArg (\l os -> os { optLanguage = (Just . readLanguage) l }) "LANGUAGE")+      languageOptionInfo+  ]++helpOptionInfo = "Print help information."+providerOptionInfo = "Which paste provider to use " ++ (argumentList . map optionName) pasteProviders+languageOptionInfo = "Which language to paste " ++ (argumentList . showBoundedEnums) languageOptionName++readLanguage :: String -> Language+readLanguage (reads -> (lang, _) : _) = lang+readLanguage s = argumentError $ printf "Unrecognized language \"%s\"" s++readProvider :: String -> SomePasteProvider+readProvider (lookupProvider -> Just p) = p+readProvider name = argumentError $ printf "Unrecognized paste provider \"%s\"" name++-- | Parse command-line arguments. Returns tuple of parsed 'HasteOptions' and+-- unparsed 'Args'.+getOptions :: Args -> (HasteOptions, Args)+getOptions args =+  case getOpt Permute options args of+    (fs, args, []) -> (applyAll fs defaultOptions, args) where applyAll = foldl (.) id+    (_, _, errors) -> argumentError (concat errors)++-- | Show all instances of a bounded enum with a custom show function.+showBoundedEnums :: (Enum a, Bounded a) => (a -> String) -> [String]+showBoundedEnums show' = map show' . enumFrom $ minBound++-- | Take a list of strings, and format them as a list of options to print with+-- help info.+argumentList :: [String] -> String+argumentList = reformat . show . sort+  where reformat = map change . filter (/= '"')+        change ',' = '|'+        change '[' = '('+        change ']' = ')'+        change c   = c++argumentError :: String -> a+argumentError = error . printf "%s Use --help for help."

@@ -0,0 +1,16 @@+module Haste.PasteProviders+  ( defaultProvider+  , lookupProvider+  , pasteProviders+  ) where++import Haste.Types+import Haste.PasteProviders.All (pasteProviders)++defaultProvider :: SomePasteProvider+defaultProvider = head pasteProviders++lookupProvider :: String -> Maybe SomePasteProvider+lookupProvider option = lookup option byName+  where byName = map optionName pasteProviders `zip` pasteProviders+

@@ -0,0 +1,18 @@+module Haste.PasteProviders.All+  ( pasteProviders+  ) where++import Haste.Types++import Haste.PasteProviders.Paste2+import Haste.PasteProviders.Pastebin+import Haste.PasteProviders.HPaste+import Haste.PasteProviders.Console++pasteProviders :: [SomePasteProvider]+pasteProviders = [ SomePasteProvider Paste2+                 , SomePasteProvider Pastebin+                 , SomePasteProvider HPaste+                 , SomePasteProvider Console+                 ]+

@@ -0,0 +1,18 @@+module Haste.PasteProviders.Console+  ( Console (..)+  ) where++import Haste.Post+import Haste.Types+import Haste.Monad++data Console = Console+  deriving Show++instance PasteProvider Console where++  paste _ text = do+    liftIO $ putStrLn text+    return ""++

@@ -0,0 +1,34 @@+module Haste.PasteProviders.HPaste+  ( HPaste (HPaste)+  ) where++import Data.Maybe (fromMaybe)+import qualified Data.Char as Char++import Haste.Post+import Haste.Types+import Haste.Monad++data HPaste = HPaste+  deriving Show++defaultLang = "text"++langaugeKey :: Language -> String+langaugeKey = map Char.toLower . show++instance PasteProvider HPaste where+  preferredLanguages _ = [Haskell]++  paste _ text = do+    lang <- asks envLanguage+    resp <- post "http://hpaste.org/fastcgi/hpaste.fcgi/save" [ "title" :=> ""+                                                              , "author" :=> ""+                                                              , "content" :=> text+                                                              , "language" :=> langaugeKey lang+                                                              , "channel" :=> "none"+                                                              ]+    return $ case lookup "Location" (headers resp) of+              Nothing  -> error . statusLine $ resp+              Just loc -> "http://hpaste.org" ++ tail loc+

@@ -0,0 +1,32 @@+module Haste.PasteProviders.Paste2+  ( Paste2 (Paste2)+  ) where++import Data.Maybe (fromMaybe)+import qualified Data.Char as C++import Haste.Post+import Haste.Types+import Haste.Monad++data Paste2 = Paste2+  deriving Show++defaultLang = "text"++langaugeKey :: Language -> String+langaugeKey = map C.toLower . show++instance PasteProvider Paste2 where++  paste _ text = do+    lang <- asks envLanguage+    resp <- post "http://paste2.org/new-paste" [ "code"        :=> text+                                               , "lang"        :=> langaugeKey lang+                                               , "parent"      :=> "0"+                                               , "description" :=> ""+                                               ]+    return $ case lookup "Location" (headers resp) of+              Nothing  -> error . statusLine $ resp+              Just loc -> "http://paste2.org" ++ tail loc+

@@ -0,0 +1,30 @@+module Haste.PasteProviders.Pastebin+  ( Pastebin (Pastebin)+  ) where++import Data.Char (isSpace)++import Haste.Post+import Haste.Types+import Haste.Monad++data Pastebin = Pastebin+  deriving Show++instance PasteProvider Pastebin where++  paste _ text = do+    resp <- post "http://pastebin.com/pastebin.php" [ "poster"     :=> ""+                                                    , "format"     :=> "text"+                                                    , "code2"      :=> text+                                                    , "expiry"     :=> "m"+                                                    , "remember"   :=> "0"+                                                    , "parent_pid" :=> ""+                                                    , "paste"      :=> "Send"+                                                    ]+    return $ case lookup "Location" (headers resp) of+              Nothing  -> error . statusLine $ resp+              Just loc -> strip loc++strip :: String -> String+strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace

@@ -0,0 +1,31 @@+{-# OPTIONS_GHC -XScopedTypeVariables #-}++module Haste.Post+  ( post+  , PostParameter (..)+  , PostResponse (..)+  ) where++import Haste.Types+import Haste.Monad (liftIO)++import Network.Curl hiding (URLString)++data PostParameter = String :=> String+data PostResponse = PostResponse { statusLine :: String+                                 , headers :: [(String, String)]+                                 , body :: String+                                 }++post :: URLString -> [PostParameter] -> HM PostResponse+post url params = liftIO $ do+  resp ::  CurlResponse_ [(String, String)] String+    <- curlGetResponse_ url  [CurlHttpPost $ map httpPost params]+  return PostResponse { statusLine = respStatusLine resp+                      , headers = respHeaders resp+                      , body    = respBody resp+                      }++httpPost :: PostParameter -> HttpPost+httpPost (k :=> v) = HttpPost k (Just "text/plain") (ContentString v) [] Nothing+

@@ -0,0 +1,72 @@+{-# LANGUAGE ExistentialQuantification #-}++module Haste.Types+  ( HM+  , Args+  , URLString+  , Description+  , Language (..)+  , PasteProvider (..)+  , SomePasteProvider (..)+  , HasteOptions (..)+  , HasteEnvironment (..)+  , languageOptionName+  ) where++import Data.Char (toLower)++import Control.Monad.Reader+import qualified Data.Char as Char++type HM = ReaderT HasteEnvironment IO++type URLString = String+type Args = [String]+type Description = String++data Language+  = Text+  | Haskell+  | Bash+  | C+  | Java+  | Perl+  | Python+  deriving (Eq, Enum, Bounded, Show, Read)++class (Show a) => PasteProvider a where+  paste :: a -> String -> HM URLString++  optionName :: a -> String+  optionName = map toLower . show++  preferredLanguages :: a -> [Language]+  preferredLanguages _ = []++data SomePasteProvider = forall a. PasteProvider a => SomePasteProvider a++instance Show SomePasteProvider where+  show (SomePasteProvider p) = show p++instance PasteProvider SomePasteProvider where+  paste (SomePasteProvider p) = paste p+  optionName (SomePasteProvider p) = optionName p+  preferredLanguages (SomePasteProvider p) = preferredLanguages p++data HasteOptions =+  HasteOptions+    { optProvider :: Maybe SomePasteProvider+    , optLanguage :: Maybe Language+    , optHelp :: Bool+    }+  deriving (Show)++data HasteEnvironment =+  HasteEnvironment+    { envContent :: String+    , envLanguage :: Language+    }+  deriving (Show, Eq)++languageOptionName :: Language -> String+languageOptionName = map toLower . show

@@ -0,0 +1,68 @@+-----------------------------------------------------------------------------+---- |+---- Module      : Main+---- Copyright   : David Siegel+---- License     : BSD3-style (see LICENSE)+---- +---- Maintainer  : David Siegel <djsiegel@gmail.com>+---- Stability   : experimental+---- Portability : ?+----+---- A universal pastebin tool in Haskell.+----+-------------------------------------------------------------------------------++module Main where++import System.Exit+import System.Environment (getArgs)+import Data.Maybe (fromMaybe, listToMaybe)+import Control.Monad (when)++import Haste.Types+import Haste.Monad (runHaste)+import Haste.Options (getOptions, helpText)+import Haste.PasteProviders (defaultProvider)+import qualified Haste.LanguageDetection as LD++-- | Starts the show.+main :: IO ()+main = do+  -- Parse options.+  (options, args) <- fmap getOptions getArgs++  when (optHelp options) $ do+    putStrLn helpText+    exitSuccess++  let language = decideLanguage options args+  let provider = decideProvider options args+  content <- decideContent options args++  let env = HasteEnvironment { envContent = content+                             , envLanguage = decideLanguage options args+                             } +  result <- runHaste env (paste provider content)+  putStrLn result++-- | If a filename is given, we use its contents; else use STDIN.+decideContent :: HasteOptions -> Args -> IO String+decideContent _ []         = getContents+decideContent _ (file : _) = readFile file++decideLanguage :: HasteOptions -> Args -> Language+-- If a language is passed as an option, use it.+decideLanguage (optLanguage -> Just lang) _        = lang+-- Else, attempt to guess language from file argument.+decideLanguage _ (file : _) = fromMaybe Text (LD.fromFilePath file)+-- Else use Text.+decideLanguage _ _          = Text++decideProvider :: HasteOptions -> Args -> SomePasteProvider+-- If a provider was specified, use it.+decideProvider (optProvider -> Just p) _ = p+-- Else, we suggest one based on language.+decideProvider options args =+  case LD.preferredProviders (decideLanguage options args) of+    p : _ -> p+    _     -> defaultProvider