alfred 0.1 → 0.2
raw patch · 3 files changed
+147/−50 lines, 3 filesdep +hexpat
Dependencies added: hexpat
Files
- alfred.cabal +4/−3
- src/Alfred.hs +47/−28
- src/Alfred/Query.hs +96/−19
alfred.cabal view
@@ -1,7 +1,7 @@ Name: alfred-Version: 0.1+Version: 0.2 Synopsis: utility library for Alfred version 2-Description: A utility library for writing workflows for Alfred version 2.+Description: A utility library for writing workflows for Alfred version 2 (<http://www.alfredapp.com>). Category: Utils@@ -20,6 +20,7 @@ Exposed-Modules: Alfred Alfred.Query - Build-Depends: base == 4.*, aeson >= 0.7, bytestring, text >= 1.0, xmlgen, network, HTTP+ Build-Depends: base == 4.*, aeson >= 0.7, bytestring, text >= 1.0, xmlgen, network, HTTP,+ hexpat >= 0.20 hs-source-dirs: src ghc-options: -W
src/Alfred.hs view
@@ -27,13 +27,14 @@ -- -- suggestURL = "http://suggestqueries.google.com/complete/search?output=toolbar&client=firefox&hl=en&q=" -- --- mkItems :: (Text, [Text]) -> [Item]--- mkItems = mkSearchItems MkSearch {+-- 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, "."],+-- suggestError = \s -> T.concat ["Could not load suggestions! Google for ", s, "."], -- found = \s -> T.concat ["Search results for ", s]}--- --- main = runScript runQuery mkItems+--+-- main = runScript (transformQuery snd runQuery) mkItems -- @ -- --@@ -42,19 +43,24 @@ module Alfred ( Item (..)+ , item , Icon (..)+ , Renderer+ , Renderer' , runScript , runScript'- , mkSearchItems- , MkSearch (..)) where+ , searchRenderer+ , Search (..)) where import Text.XML.Generator import qualified Data.ByteString as B import Data.Text (Text)+import qualified Data.Text as T import Data.ByteString (ByteString) import Data.Monoid import System.Environment import Data.List+import Control.Applicative import Alfred.Query @@ -72,6 +78,11 @@ , icon :: Maybe Icon } +-- | Default item.+item :: Item+item = Item {uid=Nothing,arg=undefined,isFile=False,valid=Nothing,+ autocomplete=Nothing,title=undefined, subtitle=undefined,+ icon=Just (IconFile "icon.png")} -- | A list of items. type Items = [Item]@@ -118,32 +129,38 @@ printItems :: Items -> IO () printItems = B.putStr . renderItems +-- | This type represents rendering functions as used by 'runScript'.+type Renderer a = Renderer' Text a +-- | This type represents rendering functions as used by 'runScript''.+type Renderer' q a = (q -> Either String a -> Items)+ -- | 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+runScript' :: ([Text] -> q)+ -> Query' q a -- ^ query function+ -> Renderer' q a -- ^ rendering function -> IO ()-runScript' runQuery mkItems = do- args <- getArgs+runScript' inp runQuery mkItems = do+ args <- (inp . map T.pack) <$> getArgs res <- runQuery args- printItems $ mkItems res+ printItems $ mkItems args 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+runScript :: Query a -- ^ query function+ -> Renderer a -- ^ rendering function -> IO ()-runScript runQuery = runScript' (runQuery . concat . intersperse " ")+runScript = runScript' (T.concat . intersperse " ") -- | This data type represents standard search scripts used by--- 'mkSearchItems'.-data MkSearch = MkSearch {searchURL, found, notFound :: Text -> Text}+-- 'searchRenderer'.+data Search = Search {searchURL, found, notFound, suggestError :: Text -> Text} -- | This function produces a rendering function for standard search@@ -152,26 +169,28 @@ -- -- @ -- mkItems :: (Text, [Text]) -> Items--- mkItems = mkSearchItems MkSearch {+-- mkItems = mkSearchItems 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]} -- @ -- -mkSearchItems :: MkSearch -> (Text, [Text]) -> Items-mkSearchItems MkSearch {searchURL, found, notFound} suggs = +searchRenderer :: Search -> Renderer [Text]+searchRenderer Search {suggestError, searchURL} s (Left _) = + [Item {uid=Nothing,arg=searchURL (escapeText s),isFile=False,+ valid=Nothing,autocomplete=Nothing,title=s,+ subtitle=suggestError s,icon=Just (IconFile "icon.png")}]+searchRenderer Search {searchURL, found, notFound} s (Right suggs) = case suggs of- (s,[]) -> [Item {uid=Nothing,arg=searchURL (escapeText s),isFile=False,+ [] -> [Item {uid=Nothing,arg=searchURL2 (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")}]+ res -> map mkItem res 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")}-+ mkItem t = Item {uid=Nothing,arg=arg,isFile=False,valid=Nothing,+ autocomplete=Just t, title=t, subtitle=found t,icon=Just (IconFile "icon.png")}+ where arg = T.concat ["\"",searchURL (escapeText t),"\" \"", searchURL (escapeText s), "\""]+ searchURL2 s = T.concat ["\"",url,"\" \"", url, "\""]+ where url = searchURL s
src/Alfred/Query.hs view
@@ -1,20 +1,41 @@-module Alfred.Query (jsonQuery,escapeString,escapeText) where+{-# LANGUAGE TypeSynonymInstances #-} +module Alfred.Query + ( jsonQuery+ , xmlQuery+ , xmlQueryLazy+ , escapeString+ , escapeText+ , Query+ , transformQuery+ , Query'+ ) where+ import Network.HTTP+import Network.BufferType 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)+import System.IO.Error +import Text.XML.Expat.Tree +-- | Type representing queries for use in 'Alfred.runScript'.+type Query a = Query' Text a++-- | Alternative type representing queries for use in+-- 'Alfred.runScript''.+type Query' q a = q -> IO (Either String a)++ -- | 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:+-- second one (after escaping it). The returned query takes a string+-- as an argument and appends it to the base url to obtain the url+-- that is used for the query. The result is then parsed as a JSON+-- object. For example, for a Google search: -- -- @ -- runQuery :: String -> IO (Text,[Text])@@ -24,23 +45,79 @@ -- @ -- -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" ++ +jsonQuery :: FromJSON a => Text -> Query a+jsonQuery = genericQuery mkJSONRequest result + where result res = case eitherDecodeStrict (rspBody res) of+ Left msg -> return $ Left ("JSON decoding error: " ++ msg ++ "\n" ++ show (rspBody res))- Right res -> return res+ Right res -> return (Right res) -mkJSONRequest :: URI -> Request ByteString++-- | Constructions a request for doing an XML query.++mkJSONRequest :: BufferType ty => URI -> Request ty mkJSONRequest url = setHeaders (mkRequest GET url) jsonHeaders+ where jsonHeaders :: [Header]+ jsonHeaders = [mkHeader HdrContentType "application/json"] -jsonHeaders :: [Header]-jsonHeaders = [mkHeader HdrContentType "application/json"]+-- | 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 returned query takes a string+-- as an argument and appends it to the base url to obtain the url+-- that is used for the query. The result is then parsed as an XML+-- document. For example, for a DBLP search:+--+-- @+-- runQuery :: Query (Node Text Text)+-- runQuery query = xmlQuery suggestURL query+-- +-- suggestURL = "http://dblp.uni-trier.de/search/author?xauthor="+-- @+-- +++xmlQuery :: (GenericXMLString a, GenericXMLString b) => Text -> Query (Node a b)+xmlQuery = genericQuery mkXMLRequest result+ where result res = case parse' defaultParseOptions (rspBody res) of+ Left msg -> return $ Left ("XML decoding error: " ++ show msg + ++ "\n" ++ show (rspBody res))+ Right tree -> return (Right tree)++-- | Lazy variant of 'xmlQueryLazy'. This function may be useful if+-- results tend to be lengthy and only a small prefix of the result is+-- used.+xmlQueryLazy :: (GenericXMLString a, GenericXMLString b) => Text -> Query (Node a b)+xmlQueryLazy = genericQuery mkXMLRequest result+ where result res = let (tree, _) = parse defaultParseOptions (rspBody res) + in return (Right tree)++-- | Generic function to construct queries.+genericQuery :: HStream ty => (URI -> Request ty)+ -> (Response ty -> IO (Either String b))+ -> Text -> Query b+genericQuery mkRequest result base query =+ case (parseURI $ T.unpack $ T.concat [base, escapeText query]) of+ Nothing -> return $ Left "illformed url"+ Just url -> catchIOError execute (return . Left . show)+ where execute = do+ res <- simpleHTTP (mkRequest url)+ case res of+ Left err -> return $ Left (show err)+ Right res -> result res++++-- | Constructions a request for doing a JSON query.++mkXMLRequest :: BufferType ty => URI -> Request ty+mkXMLRequest url = setHeaders (mkRequest GET url) xmlHeaders+ where xmlHeaders :: [Header]+ xmlHeaders = [mkHeader HdrContentType "application/xml"]+++-- | Functorial map for 'Query''.+transformQuery :: (a -> b) -> Query' q a -> Query' q b+transformQuery f = fmap (fmap (fmap f)) -- | Escapes the string for use in a URL. escapeString :: String -> String