alfred-0.5: utility library for Alfred version 2

Copyright(c) 2014 Patrick Bahr
LicenseBSD3
MaintainerPatrick Bahr <paba@di.ku.dk>
Stabilityexperimental
Portabilitynon-portable (GHC Extensions)
Safe HaskellNone
LanguageHaskell98

Alfred

Description

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 :: Query (Text,[Text])
runQuery = jsonQuery suggestURL

suggestURL = "http://google.com/complete/search?client=firefox&q="

mkItems :: Renderer [Text]
mkItems = searchRenderer Search {
            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 (transformQuery snd runQuery) mkItems

Synopsis

Documentation

data Item Source

This type represents items that should be rendered by Alfred as the result of a script filter.

Constructors

Item 

item :: Item Source

Default item.

data Icon Source

Represents icons of an item.

type Renderer a = Renderer' Text a Source

This type represents rendering functions as used by runScript.

type Renderer' q a = q -> Either Text a -> Items Source

This type represents rendering functions as used by runScript'.

runScript Source

Arguments

:: Query a

query function

-> Renderer a

rendering function

-> IO () 

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' Source

Arguments

:: ([Text] -> q) 
-> Query' q a

query function

-> Renderer' q a

rendering function

-> IO () 

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.

searchRenderer :: Search Text -> Renderer [Text] Source

This function produces a rendering function for standard search scripts. For example a Google search rendering function is defined as follows:

 mkItems :: Renderer [Text]
 mkItems = searchRenderer Search {
             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]}

searchRenderer' :: Search' a -> Renderer [a] Source

This function produces a rendering function for standard search scripts. As opposed to the simpler variant searchRenderer, this function works on arbitrary query result types. For example a DBLP search rendering function is defined as follows:

 mkItems :: Renderer [(Text, Text)]
 mkItems = searchRenderer' Search'{
             simpleSearch = Search {
               searchURL = s -> T.concat ["http://dblp.uni-trier.de/search/author?author=", s],
               notFound = s -> T.concat ["No suggestion. Search DBLP for ", s, "."],
               found = (s,_) -> T.concat ["Open bibliography of ", s]},
             resultURL = (_,r) -> T.concat ["http://dblp.uni-trier.de/pers/hd/",r,".html"],
             resultTitle = fst}

In the above example the query result type is (Text,Text) where the first component is the name of the result and the second component is used to construct a URL that leads directly to the search result.

data Search a Source

This data type represents standard search scripts used by searchRenderer.

Constructors

Search 

Fields

searchURL :: Text -> Text
 
notFound :: Text -> Text
 
found :: a -> Text
 

data Search' a Source

This data type represents advanced standard search scripts used by searchRenderer'.

Constructors

Search' 

Fields

simpleSearch :: Search a
 
resultURL :: a -> Text
 
resultTitle :: a -> Text