diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/alfred.cabal b/alfred.cabal new file mode 100644 --- /dev/null +++ b/alfred.cabal @@ -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 diff --git a/src/Alfred.hs b/src/Alfred.hs new file mode 100644 --- /dev/null +++ b/src/Alfred.hs @@ -0,0 +1,177 @@ +{-# LANGUAGE OverloadedStrings, NamedFieldPuns #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Alfred +-- Copyright : (c) 2014 Patrick Bahr +-- License : BSD3 +-- Maintainer : Patrick Bahr +-- 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")} + diff --git a/src/Alfred/Query.hs b/src/Alfred/Query.hs new file mode 100644 --- /dev/null +++ b/src/Alfred/Query.hs @@ -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