givegif (empty) → 1.0.0.0
raw patch · 9 files changed
+434/−0 lines, 9 filesdep +basedep +base64-bytestringdep +bytestringsetup-changed
Dependencies added: base, base64-bytestring, bytestring, containers, errors, giphy-api, givegif, hspec, lens, network-uri, optparse-applicative, text, transformers, wreq
Files
- LICENSE +30/−0
- README.md +50/−0
- Setup.hs +2/−0
- app/Main.hs +135/−0
- givegif.cabal +79/−0
- src/Console.hs +86/−0
- src/Options/Applicative/Text.hs +17/−0
- stack.yaml +6/−0
- test/Spec.hs +29/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Pascal Hartig (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Pascal Hartig nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,50 @@+# givegif++[](https://travis-ci.org/passy/givegif)++**WARNING: Some of the steps in the readme don't quite reflect reality yet.**++> Find and display GIFs from the command line.++## Demo++++## Usage++```+Usage: givegif [-n|--no-preview] ([-s|--search ARG] | [-t|--translate ARG] |+ [RANDOM_TAG])+ Find GIFs on the command line.++Available options:+ -h,--help Show this help text+ -n,--no-preview Don't render an inline image preview.+ -s,--search ARG Use search to find a matching GIF.+ -t,--translate ARG Use translate to find a matching GIF.+ -V,--version Show version information+```++## Installation++Check out the latest [releases](https://github.com/passy/givegif/releases) for+precompiled binaries.++Alternatively, feel free to build it yourself with+[stack](http://haskellstack.org).+++```bash+$ stack install givegif+$ givegif -V+givegif 1.0.0.0+```++## Known Issues++Even though I tried to make this work with screen/tmux, it still glitches out+every now and then. If you can figure out why, please let me know.++## License++BSD-3
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++import qualified Control.Error.Util as Err+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Lazy.Char8 as BS8+import qualified Data.Text as T+import qualified Data.Text.IO as TIO+import qualified Network.Wreq as Wreq+import qualified Options.Applicative as Opt+import qualified Options.Applicative.Text as Opt+import qualified Web.Giphy as Giphy++import Control.Applicative (optional, (<**>), (<|>))+import Control.Lens (Getting (), preview)+import Control.Lens.At (at)+import Control.Lens.Cons (_head)+import Control.Lens.Operators+import Control.Lens.Prism (_Left, _Right)+import Control.Monad (join, unless)+import Data.Monoid (First (), (<>))+import Data.Version (Version (), showVersion)+import Paths_givegif (version)+import System.Environment (getProgName)+import System.IO (stderr)++import Console++data Options = Options+ { optNoPreview :: Bool+ , optMode :: SearchMode+ }++data SearchMode = OptSearch T.Text | OptTranslate T.Text | OptRandom (Maybe T.Text)++options :: Opt.Parser Options+options =+ Options <$> Opt.switch ( Opt.long "no-preview"+ <> Opt.short 'n'+ <> Opt.help "Don't render an inline image preview." )+ <*> ( ( OptSearch <$> Opt.textOption ( Opt.long "search"+ <> Opt.short 's'+ <> Opt.help "Use search to find a matching GIF." ) )+ <|> ( OptTranslate <$> Opt.textOption ( Opt.long "translate"+ <> Opt.short 't'+ <> Opt.help "Use translate to find a matching GIF." ) )+ <|> ( OptRandom <$> optional ( Opt.textArgument ( Opt.metavar "RANDOM_TAG" ) ) ) )++cliParser :: String -> Version -> Opt.ParserInfo Options+cliParser progName ver =+ Opt.info ( Opt.helper <*> options <**> versionInfo )+ ( Opt.fullDesc+ <> Opt.progDesc "Find GIFs on the command line."+ <> Opt.header progName )+ where+ versionInfo = Opt.infoOption ( unwords [progName, showVersion ver] )+ ( Opt.short 'V'+ <> Opt.long "version"+ <> Opt.hidden+ <> Opt.help "Show version information" )++apiKey :: Giphy.Key+apiKey = Giphy.Key "dc6zaTOxFJmzC"++taggedPreview+ :: t+ -> Getting (First a) s a+ -> s+ -> Either t a+taggedPreview tag l s = Err.note tag $ preview l s++main :: IO ()+main = do+ progName <- getProgName+ Opt.execParser (cliParser progName version) >>= run+ where+ run :: Options -> IO ()+ run opts = do+ let config = Giphy.GiphyConfig apiKey+ let app = getApp opts+ resp <- Giphy.runGiphy app config++ -- Get the first result and turn the left side into a String error+ let fstRes = resp & _Right %~ taggedPreview "No results found." _head+ & _Left %~ T.pack . show+ & join++ -- Turn the right hand side into an Either.+ let fstUrl = fstRes & _Right %~ taggedPreview "No images attached."+ ( Giphy.gifImages+ . at "original"+ . traverse+ . Giphy.imageUrl+ . traverse )+ & join++ -- TODO: Understand lens actions and perform the fetch + tuple transform+ -- through it.+ let doReq uri = Wreq.get uri >>= (\resp' -> return (uri, resp'))+ resp' <- sequence $ doReq <$> (show <$> fstUrl)++ case resp' of+ Right r -> uncurry (printGif opts) r+ Left e -> TIO.hPutStrLn stderr $ "Error: " <> e++ getApp :: Options -> Giphy.Giphy [Giphy.Gif]+ getApp opts =+ case optMode opts of+ OptSearch s -> searchApp s+ OptTranslate t -> translateApp t+ OptRandom r -> randomApp r++ printGif :: Options -> String -> Wreq.Response BSL.ByteString -> IO ()+ printGif opts uri r = do+ unless (optNoPreview opts) $ do+ render <- getImageRenderer+ BS8.putStrLn . render $ consoleImage True (r ^. Wreq.responseBody)+ putStrLn uri++translateApp :: T.Text -> Giphy.Giphy [Giphy.Gif]+translateApp q = do+ resp <- Giphy.translate $ Giphy.Phrase q+ return . pure $ resp ^. Giphy.translateItem++searchApp :: T.Text -> Giphy.Giphy [Giphy.Gif]+searchApp q = do+ resp <- Giphy.search $ Giphy.Query q+ return $ resp ^. Giphy.searchItems++randomApp :: Maybe T.Text -> Giphy.Giphy [Giphy.Gif]+randomApp q = do+ resp <- Giphy.random $ Giphy.Tag <$> q+ return . pure $ resp ^. Giphy.randomGifItem
+ givegif.cabal view
@@ -0,0 +1,79 @@+-- This file has been generated from package.yaml by hpack version 0.9.0.+--+-- see: https://github.com/sol/hpack++name: givegif+version: 1.0.0.0+synopsis: CLI Giphy search tool with previews in iTerm 2+description: Please see README.md+homepage: http://github.com/passy/givegif#readme+license: BSD3+license-file: LICENSE+author: Pascal Hartig+maintainer: Pascal Hartig <phartig@rdrei.net>+category: Console+build-type: Simple+cabal-version: >= 1.10++extra-source-files:+ README.md+ stack.yaml++library+ hs-source-dirs:+ src+ ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction -fwarn-unused-do-bind+ build-depends:+ base >= 4.7 && < 5+ , text+ , network-uri+ , giphy-api+ , bytestring+ , base64-bytestring+ , containers+ , optparse-applicative+ exposed-modules:+ Console+ Options.Applicative.Text+ other-modules:+ Paths_givegif+ default-language: Haskell2010++executable givegif+ main-is: Main.hs+ hs-source-dirs:+ app+ ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction -fwarn-unused-do-bind -threaded -rtsopts -with-rtsopts=-N -Wall+ build-depends:+ base >= 4.7 && < 5+ , text+ , network-uri+ , givegif+ , giphy-api+ , optparse-applicative+ , bytestring+ , lens+ , wreq+ , transformers+ , errors+ other-modules:+ Paths_givegif+ default-language: Haskell2010++test-suite spec+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs:+ test+ ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction -fwarn-unused-do-bind -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >= 4.7 && < 5+ , text+ , network-uri+ , givegif+ , bytestring+ , base64-bytestring+ , hspec+ , lens+ , containers+ default-language: Haskell2010
+ src/Console.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE OverloadedStrings #-}++module Console where++import Control.Applicative (empty)+import qualified Data.ByteString.Base64.Lazy as B64+import qualified Data.ByteString.Builder as B+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy.Char8 as BS8+import Data.List (isPrefixOf)+import qualified Data.Map.Strict as M+import Data.Maybe (catMaybes)+import Data.Monoid ((<>))+import qualified System.Environment as Env++data ConsoleImage = ConsoleImage+ { ciInline :: !Bool+ , ciImage :: !ByteString+ , ciName :: !(Maybe ByteString)+ , ciWidth :: !(Maybe Int)+ , ciHeight :: !(Maybe Int)+ , ciPreserveAspectRatio :: !(Maybe Bool)+ } deriving (Eq, Show)++consoleImage :: Bool -> ByteString -> ConsoleImage+consoleImage inline image = ConsoleImage { ciInline = inline+ , ciImage = image+ , ciName = empty+ , ciWidth = empty+ , ciHeight = empty+ , ciPreserveAspectRatio = empty+ }++esc :: B.Builder+esc = B.char8 '\ESC'++imageToMap :: ConsoleImage -> M.Map ByteString ByteString+imageToMap img = M.union initial extra+ where+ btoi :: Bool -> Int+ btoi b = if b then 1 else 0++ showPack :: Show a => a -> ByteString+ showPack = BS8.pack . show++ initial = M.singleton "inline" $ (showPack . btoi . ciInline) img+ extra = M.fromList $ filterSnd [ ("name", ciName img)+ , ("width", showPack <$> ciWidth img)+ , ("height", showPack <$> ciHeight img)+ , ("preserveAspectRatio", showPack . btoi <$> ciPreserveAspectRatio img)+ ]++ filterSnd :: [(a, Maybe b)] -> [(a, b)]+ filterSnd = catMaybes . (liftSnd <$>)++ liftSnd :: (a, Maybe b) -> Maybe (a, b)+ liftSnd (a, Just b) = Just (a, b)+ liftSnd _ = Nothing++getImageRenderer :: IO (ConsoleImage -> ByteString)+getImageRenderer = do+ screen <- isScreen+ let pre = if screen then screenPreamble else mempty <> esc <> B.stringUtf8 "]1337;File="+ let post = B.char8 '\a' <> if screen then screenPost else mempty++ return $ renderImage pre post++ where+ screenPreamble = esc <> B.stringUtf8 "Ptmux;" <> esc+ screenPost = esc <> B.char8 '\\'++renderImage :: B.Builder -> B.Builder -> ConsoleImage -> ByteString+renderImage pre post img =+ let b64 = B.lazyByteString $ B64.encode (ciImage img)+ p = imageToMap img+ in B.toLazyByteString $ pre <> params p <> ":" <> b64 <> post++params :: M.Map ByteString ByteString -> B.Builder+params = snd . M.foldrWithKey' f (True, mempty)+ where+ f k a (empty', b) = let start = if empty' then b else b <> B.char8 ';'+ end = B.lazyByteString k <> B.char8 '=' <> B.lazyByteString a+ in (False, start <> end)++isScreen :: IO Bool+isScreen = isPrefixOf "screen" <$> Env.getEnv "TERM"
+ src/Options/Applicative/Text.hs view
@@ -0,0 +1,17 @@+module Options.Applicative.Text+ ( text+ , textOption+ , textArgument ) where++import qualified Data.Text as T+import qualified Options.Applicative as Opt+import qualified Options.Applicative.Types as Opt++text :: Opt.ReadM T.Text+text = T.pack <$> Opt.readerAsk++textOption :: Opt.Mod Opt.OptionFields T.Text -> Opt.Parser T.Text+textOption = Opt.option text++textArgument :: Opt.Mod Opt.ArgumentFields T.Text -> Opt.Parser T.Text+textArgument = Opt.argument text
+ stack.yaml view
@@ -0,0 +1,6 @@+flags: {}+extra-package-dbs: []+packages:+- '.'+extra-deps: []+resolver: nightly-2016-04-05
+ test/Spec.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++import Prelude+import Test.Hspec+import qualified Console as C+import qualified Data.Map.Strict as M+import qualified Data.Set as S+import qualified Data.ByteString.Builder as B++main :: IO ()+main = hspec $ do+ describe "Console Module" $ do+ describe "imageToMap" $ do+ let img = (C.consoleImage True "data") { C.ciName = pure "myimage.png"+ , C.ciPreserveAspectRatio = pure True }+ it "has the right keys" $ do+ let m = C.imageToMap img+ M.keysSet m `shouldBe` S.fromList [ "inline", "name", "preserveAspectRatio" ]+ it "creates the right params" $ do+ let p = B.toLazyByteString . C.params . C.imageToMap $ img+ p `shouldBe` "preserveAspectRatio=1;name=myimage.png;inline=1"+ describe "renderImage" $ do+ it "renders an image without pre/post" $ do+ let img = C.consoleImage True ""+ C.renderImage "" "" img `shouldBe` "inline=1:"+ it "renders an image with pre/post" $ do+ let img = C.consoleImage True "data"+ C.renderImage "pre" "post" img `shouldBe` "preinline=1:ZGF0YQ==post"