packages feed

alfred (empty) → 0.1

raw patch · 5 files changed

+285/−0 lines, 5 filesdep +HTTPdep +aesondep +basesetup-changed

Dependencies added: HTTP, aeson, base, bytestring, network, text, xmlgen

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014 Patrick Bahr++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. 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.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ alfred.cabal view
@@ -0,0 +1,25 @@+Name:                   alfred+Version:                0.1+Synopsis:               utility library for Alfred version 2+Description:            A utility library for writing workflows for Alfred version 2.+++Category:               Utils+License:                BSD3+License-file:           LICENSE+Author:                 Patrick Bahr+Maintainer:             paba@di.ku.dk+Build-Type:             Simple+Cabal-Version:          >=1.9.2++source-repository head+  type:     git+  location: https://github.com/pa-ba/alfred.git++library+  Exposed-Modules:      Alfred+                        Alfred.Query++  Build-Depends:        base == 4.*, aeson >= 0.7, bytestring, text >= 1.0, xmlgen, network, HTTP+  hs-source-dirs:       src+  ghc-options:          -W
+ src/Alfred.hs view
@@ -0,0 +1,177 @@+{-# LANGUAGE OverloadedStrings, NamedFieldPuns #-}++--------------------------------------------------------------------------------+-- |+-- Module      :  Alfred+-- Copyright   :  (c) 2014 Patrick Bahr+-- License     :  BSD3+-- Maintainer  :  Patrick Bahr <paba@di.ku.dk>+-- Stability   :  experimental+-- Portability :  non-portable (GHC Extensions)+--+-- This module provides utility functions to interact with Alfred+-- version 2. It is intended to be used for writing "script filters"+-- used in Alfred workflows.+--  +-- For example the following excerpt defines a script for Google+-- search with auto completion:+-- +-- @+-- import Alfred+-- import Alfred.Query+-- import qualified Data.Text as T+-- import Data.Text (Text)+-- +-- runQuery :: String -> IO (Text,[Text])+-- runQuery query = jsonQuery suggestURL query+-- +-- suggestURL = "http://suggestqueries.google.com/complete/search?output=toolbar&client=firefox&hl=en&q="+-- +-- mkItems :: (Text, [Text]) -> [Item]+-- mkItems = mkSearchItems MkSearch {+--             searchURL = \s -> T.concat ["https://www.google.com/search?q=", s],+--             notFound = \s -> T.concat ["No suggestion. Google for ", s, "."],+--             found = \s -> T.concat ["Search results for ", s]}+-- +-- main = runScript runQuery mkItems+-- @+-- +--+--------------------------------------------------------------------------------+++module Alfred+    ( Item (..)+    , Icon (..)+    , runScript+    , runScript'+    , mkSearchItems+    , MkSearch (..)) where++import Text.XML.Generator+import qualified Data.ByteString as B+import Data.Text (Text)+import Data.ByteString (ByteString)+import Data.Monoid+import System.Environment+import Data.List++import Alfred.Query++-- | This type represents items that should be rendered by Alfred as+-- the result of a script filter.++data Item = Item {+      uid :: Maybe Text+    , arg :: Text+    , isFile :: Bool+    , valid :: Maybe Bool+    , autocomplete :: Maybe Text+    , title :: Text+    , subtitle :: Text+    , icon :: Maybe Icon+}+++-- | A list of items.+type Items = [Item]++-- | Represents icons of an item.++data Icon = FileIcon Text | FileType Text | IconFile Text+++-- | Render an icon as XML element.+xmlIcon :: Icon -> Xml Elem+xmlIcon icon = case icon of+               FileIcon str -> mk str (xattr "type" "fileicon")+               FileType str -> mk str (xattr "type" "filetype")+               IconFile str -> mk str mempty+    where mk :: Text -> Xml Attr -> Xml Elem+          mk str f = xelem "icon" (f <#> xtext str)++-- | Render an item as XML element.+xmlItem :: Item -> Xml Elem+xmlItem (Item  uid arg file val auto title sub icon) = +    xelem "item" $+          (uid' <> xattr "arg" arg <> val' <> auto' <> file') <#>+          (xelemWithText "title" title <> xelemWithText "subtitle" sub <> icon')+          +        where uid' = case uid of Nothing -> mempty; Just uid -> xattr "uid" uid+              val' = case val of +                       Nothing -> mempty+                       Just val -> xattr "valid" (if val then "yes" else "no")+              file' = if file then xattr "type" "file" else mempty+              auto' = case auto of Nothing -> mempty; Just auto -> xattr "autocomplete" auto+              icon' = case icon of Nothing -> mempty; Just icon -> xmlIcon icon++-- | Render items as an XML element.+xmlItems :: Items -> Xml Elem+xmlItems = xelem "items" . mconcat . map xmlItem +++-- | Render items as an XML 'ByteString'.+renderItems :: Items -> ByteString+renderItems  = xrender . xmlItems++-- | Print items as XML to stdout.+printItems :: Items -> IO ()+printItems = B.putStr . renderItems+++-- | This function runs a script consisting of a query function and a+-- rendering function. The query function takes string parameters and+-- produces an output that is then passed to the rendering function to+-- produce items that are then passed to Alfred.+runScript' :: ([String] -> IO a)  -- ^ query function+           -> (a -> Items)        -- ^ rendering function+           -> IO ()+runScript' runQuery mkItems = do+  args <- getArgs+  res <- runQuery args+  printItems $ mkItems res+++-- | This function runs a script consisting of a query function and a+-- rendering function. The query function takes string parameters and+-- produces an output that is then passed to the rendering function to+-- produce items that are then passed to Alfred.+runScript :: (String -> IO a)  -- ^ query function+          -> (a -> Items)      -- ^ rendering function+          -> IO ()+runScript runQuery = runScript' (runQuery . concat . intersperse " ")++-- | This data type represents standard search scripts used by+-- 'mkSearchItems'.+data MkSearch = MkSearch {searchURL, found, notFound :: Text -> Text}+++-- | This function produces a rendering function for standard search+-- scripts. For example a Google search rendering function is defined+-- as follows:+-- +-- @+-- mkItems :: (Text, [Text]) -> Items+-- mkItems = mkSearchItems MkSearch {+--             searchURL = \s -> T.concat ["https://www.google.com/search?q=", s],+--             notFound = \s -> T.concat ["No suggestion. Google for ", s, "."],+--             found = \s -> T.concat ["Search results for ", s]}+-- @+--++mkSearchItems :: MkSearch -> (Text, [Text]) -> Items+mkSearchItems MkSearch {searchURL, found, notFound} suggs = +    case suggs of+      (s,[]) -> [Item {uid=Nothing,arg=searchURL (escapeText s),isFile=False,+                       valid=Nothing,autocomplete=Nothing,title=s,+                       subtitle=notFound s,icon=Just (IconFile "icon.png")}]+      (s,res@(r:_)) ->  first ++ map mkItem res+         where first = if s == r then []+                       else [Item {uid=Nothing,arg=searchURL (escapeText s),isFile=False,+                              valid=Nothing,autocomplete=Just r, title=s, subtitle=found s,+                              icon=Just (IconFile "icon.png")}]++  where mkItem :: Text -> Item+        mkItem s = Item {uid=Nothing,arg=searchURL (escapeText s),isFile=False,valid=Nothing,+                         autocomplete=Just s, title=s,  subtitle=found s,icon=Just (IconFile "icon.png")}+
+ src/Alfred/Query.hs view
@@ -0,0 +1,51 @@+module Alfred.Query (jsonQuery,escapeString,escapeText) where++import Network.HTTP+import Network.URI hiding (escapeString)+import Data.Aeson+import Data.ByteString (ByteString)+import Data.Char+import qualified Data.Text as T+import Data.Text (Text)+++-- | This function performs a query by performing an HTTP GET request+-- at the url obtained by concatenating the first argument with the+-- second one (after escaping it). The first argument is intended to+-- be the base url and the second one the query string. The result is+-- then parsed as a JSON object. For example,+-- for a Google search:+-- +-- @+-- runQuery :: String -> IO (Text,[Text])+-- runQuery query = jsonQuery suggestURL query+-- +-- suggestURL = "http://suggestqueries.google.com/complete/search?output=toolbar&client=firefox&hl=en&q="+-- @+-- ++jsonQuery :: FromJSON a => String -> String -> IO a+jsonQuery base query =+   case (parseURI $ base ++ escapeString query) of+     Nothing -> error "illformed url"+     Just url -> do res <- simpleHTTP (mkJSONRequest url)+                    case res of+                      Left err -> error (show err)+                      Right res ->  case eitherDecodeStrict (rspBody res) of+                                      Left msg -> error ("JSON decoding error: " ++ msg ++ "\n" ++ +                                                   show (rspBody res))+                                      Right res -> return res++mkJSONRequest :: URI -> Request ByteString+mkJSONRequest url = setHeaders (mkRequest GET url) jsonHeaders++jsonHeaders :: [Header]+jsonHeaders = [mkHeader HdrContentType "application/json"]++-- | Escapes the string for use in a URL.+escapeString :: String -> String+escapeString = escapeURIString isAlphaNum++-- | Escapes the text for use in a URL.+escapeText :: Text -> Text+escapeText = T.pack . escapeString . T.unpack