module Alfred
( Item (..)
, item
, Icon (..)
, Renderer
, Renderer'
, runScript
, runScript'
, searchRenderer
, searchRenderer'
, Search (..)
, Search' (..)) where
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.List
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
import System.Environment
import Text.XML.Generator
import Alfred.Query
data Item = Item {
uid :: Maybe Text
, arg :: Text
, isFile :: Bool
, valid :: Maybe Bool
, autocomplete :: Maybe Text
, title :: Text
, subtitle :: Text
, icon :: Maybe Icon
}
item :: Item
item = Item {uid=Nothing,arg=undefined,isFile=False,valid=Nothing,
autocomplete=Nothing,title=undefined, subtitle=undefined,
icon=Just (IconFile "icon.png")}
type Items = [Item]
data Icon = FileIcon Text | FileType Text | IconFile Text
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)
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
xmlItems :: Items -> Xml Elem
xmlItems = xelem "items" . mconcat . map xmlItem
renderItems :: Items -> ByteString
renderItems = xrender . xmlItems
printItems :: Items -> IO ()
printItems = B.putStr . renderItems
type Renderer a = Renderer' Text a
type Renderer' q a = (q -> Either Text a -> Items)
runScript' :: ([Text] -> q)
-> Query' q a
-> Renderer' q a
-> IO ()
runScript' inp runQuery mkItems = do
args <- (inp . map (T.pack . umlaut)) <$> getArgs
res <- runQuery args
printItems $ mkItems args res
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
runScript :: Query a
-> Renderer a
-> IO ()
runScript = runScript' (T.concat . intersperse " ")
data Search a = Search {searchURL, notFound :: Text -> Text, found :: a -> Text}
data Search' a = Search' {simpleSearch :: Search a,
resultURL :: a -> Text, resultTitle :: a -> Text}
searchRenderer :: Search Text -> Renderer [Text]
searchRenderer s = searchRenderer' Search' { simpleSearch = s, resultURL = searchURL s . escapeText
, resultTitle = id}
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
(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