alfred 0.2.1 → 0.3

raw patch · 3 files changed

+114/−44 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• alfred.cabal +1/−1
• src/Alfred.hs +70/−23
• src/Alfred/Query.hs +43/−20

@@ -1,5 +1,5 @@ Name:                   alfred-Version:                0.2.1+Version:                0.3 Synopsis:               utility library for Alfred version 2 Description:               A utility library for writing workflows for Alfred version 2

@@ -31,7 +31,6 @@ -- 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 (transformQuery snd runQuery) mkItems@@ -50,7 +49,9 @@     , runScript     , runScript'     , searchRenderer-    , Search (..)) where+    , searchRenderer'+    , Search (..)+    , Search' (..)) where  import Text.XML.Generator import qualified Data.ByteString as B@@ -133,7 +134,7 @@ type Renderer a = Renderer' Text a  -- | This type represents rendering functions as used by 'runScript''.-type Renderer' q a = (q -> Either String a -> Items)+type Renderer' q a = (q -> Either Text a -> Items)  -- | This function runs a script consisting of a query function and a -- rendering function. The query function takes string parameters and@@ -144,11 +145,25 @@            -> Renderer' q a  -- ^ rendering function            -> IO () runScript' inp runQuery mkItems = do-  args <- (inp . map T.pack) <$> getArgs+  args <- (inp . map (T.pack . umlaut)) <$> getArgs   res <- runQuery args   printItems $ mkItems args res  +-- | Normalise strange umlauts.+umlaut :: String -> String+umlaut [] = []+umlaut ('o':'\776':r) = ('\246' : umlaut r)+umlaut ('O':'\776':r) = ('\214' : umlaut r)+umlaut ('u':'\776':r) = ('\252' : umlaut r)+umlaut ('U':'\776':r) = ('\220' : umlaut r)+umlaut ('a':'\776':r) = ('\228' : umlaut r)+umlaut ('A':'\776':r) = ('\196' : umlaut r)+umlaut ('a':'\778':r) = ('\229' : umlaut r)+umlaut ('A':'\778':r) = ('\197' : umlaut r)+umlaut (x:r) = x : umlaut r++ -- | 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@@ -160,37 +175,69 @@  -- | This data type represents standard search scripts used by -- 'searchRenderer'.-data Search = Search {searchURL, found, notFound, suggestError :: Text -> Text}+data Search = Search {searchURL, found, notFound :: Text -> Text}  +-- | This data type represents advanced standard search scripts used+-- by 'searchRenderer''.+data Search' a = Search' {simpleSearch :: Search, +                          resultURL :: a -> Text, resultTitle :: a -> 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 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]}+--  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 -> 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-      [] -> [Item {uid=Nothing,arg=searchURL2 (escapeText s),isFile=False,+searchRenderer s = searchRenderer' Search' {simpleSearch = s, resultURL = searchURL s, resultTitle = id}+++-- | 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.+++searchRenderer' :: Search' a -> Renderer [a]+searchRenderer' Search' {simpleSearch = Search {searchURL, found, notFound}, resultURL, resultTitle} s res = +    case res of +      (Right suggs) -> case suggs of+          [] -> [Item {uid=Nothing,arg=searchURL2 (escapeText s),isFile=False,                        valid=Nothing,autocomplete=Nothing,title=s,                        subtitle=notFound s,icon=Just (IconFile "icon.png")}]-      res ->  map mkItem res+          res ->  map mkItem res -  where mkItem :: Text -> Item-        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), "\""]+      (Left err) -> [Item {uid=Nothing,arg=searchURL2 (escapeText s),isFile=False,+                           valid=Nothing,autocomplete=Nothing,title= s,+                           subtitle=T.concat ["Error: ", err],icon=Just (IconFile "icon.png")}]+  where 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 ["\"",resultURL t,"\" \"", searchURL (escapeText s), "\""]+                  t' = resultTitle t         searchURL2 s = T.concat ["\"",url,"\" \"", url, "\""]             where url = searchURL s

@@ -1,7 +1,9 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeSynonymInstances #-}  module Alfred.Query      ( jsonQuery+    , jsonQuery'     , xmlQuery     , xmlQueryLazy     , escapeString@@ -15,10 +17,12 @@ import Network.BufferType import Network.URI hiding (escapeString) import Data.Aeson-import Data.Char+ import qualified Data.Text as T+ import Data.Text (Text) import System.IO.Error+import Data.ByteString  import Text.XML.Expat.Tree @@ -27,7 +31,7 @@  -- | Alternative type representing queries for use in -- 'Alfred.runScript''.-type Query' q a = q -> IO (Either String a)+type Query' q a = q -> IO (Either Text a)   -- | This function performs a query by performing an HTTP GET request@@ -38,18 +42,37 @@ -- 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="+--  runQuery :: Query (Text,[Text])+--  runQuery = jsonQuery suggestURL+--  +--  suggestURL = "http://google.com/complete/search?client=firefox&q=" -- @ --   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))+jsonQuery = jsonQuery' id+++-- | This function is a variant of 'jsonQuery' that takes a function+-- as an additional argument that is used to transform the raw+-- 'ByteString' that is returned by the query. This can be helpful if+-- the source does not provide valid UTF-8 formatted JSON. For+-- example, for a Google search:+-- +-- @+--  runQuery :: Query (Text,[Text])+--  runQuery = jsonQuery' (encodeUtf8 . decodeLatin1) suggestURL+--  +--  suggestURL = "http://google.com/complete/search?client=firefox&q="+-- @+-- +++jsonQuery' :: FromJSON a => (ByteString -> ByteString) -> Text -> Query a+jsonQuery' convert = genericQuery mkJSONRequest result +    where result res = case eitherDecodeStrict (convert $ rspBody res) of+                         Left msg -> return $ Left $ T.concat +                                     ["JSON decoding error: ", T.pack msg, "\n", T.pack $ show $ rspBody res]                          Right res -> return (Right res)  @@ -58,7 +81,7 @@ mkJSONRequest :: BufferType ty => URI -> Request ty mkJSONRequest url = setHeaders (mkRequest GET url) jsonHeaders     where jsonHeaders :: [Header]-          jsonHeaders = [mkHeader HdrContentType "application/json"]+          jsonHeaders = [mkHeader HdrContentType "application/json; charset=utf-8"]  -- | This function performs a query by performing an HTTP GET request -- at the url obtained by concatenating the first argument with the@@ -79,8 +102,8 @@ 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))+                         Left msg -> return $ Left $ T.concat +                                     ["XML decoding error: ", T.pack $ show msg ,"\n", T.pack $ show (rspBody res)]                          Right tree -> return (Right tree)  -- | Lazy variant of 'xmlQueryLazy'. This function may be useful if@@ -93,16 +116,16 @@  -- | Generic function to construct queries. genericQuery :: HStream ty => (URI -> Request ty)-             -> (Response ty -> IO (Either String b))+             -> (Response ty -> IO (Either Text 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)+genericQuery mkRequest result base query = let urlText = T.concat [base,  escapeText query] in+   case (parseURI $ T.unpack urlText) of+     Nothing -> return $ Left $ T.concat ["illformed url: ", urlText]+     Just url -> catchIOError execute (return . Left . T.pack . show)          where execute = do                  res <- simpleHTTP (mkRequest url)                  case res of-                      Left err -> return $ Left (show err)+                      Left err -> return $ Left $ T.pack (show err)                       Right res -> result res  @@ -121,7 +144,7 @@  -- | Escapes the string for use in a URL. escapeString :: String -> String-escapeString = escapeURIString isAlphaNum+escapeString = escapeURIString isUnescapedInURI  -- | Escapes the text for use in a URL. escapeText :: Text -> Text