summaryrefslogtreecommitdiffstats
path: root/Notmuch.hs
diff options
context:
space:
mode:
authortv <tv@shackspace.de>2015-01-02 00:48:25 +0100
committertv <tv@shackspace.de>2015-01-02 00:48:25 +0100
commit11d3bf814d5eef82de34e2b987de3fb6293b59d2 (patch)
treead7a8666f49784ddc9e4f3cd19db1a9384a2a38e /Notmuch.hs
parent5d556b147a593f1b8c8127883055ad07ee347af9 (diff)
remove messageDateRel
Diffstat (limited to 'Notmuch.hs')
-rw-r--r--Notmuch.hs204
1 files changed, 0 insertions, 204 deletions
diff --git a/Notmuch.hs b/Notmuch.hs
index 528c7b4..6439d97 100644
--- a/Notmuch.hs
+++ b/Notmuch.hs
@@ -111,25 +111,6 @@ notmuchReply replyTo term =
-- >>= return . eitherDecode'
-putSearchResults :: [SearchResult] -> IO ()
-putSearchResults = mapM_ (T.putStrLn . drawSearchResult)
-
-
-showThread :: String -> IO ()
-showThread tid = do
- c' <- notmuch [ "show", "--format=json", "--format-version=2"
- , "thread:" <> tid ]
-
- let threads = case eitherDecode' c' :: Either String [Thread] of
- Left err -> error err
- Right x -> x
- --threadsF = map threadForest threads
- ttt = head $ threadForest $ head $ threads
-
- --Prelude.putStrLn $ drawTree $ fmap drawMessage ttt
- Prelude.putStrLn $ showTree $ ttt
-
-
getThread :: String -> IO (Forest Message)
getThread tid = do
c' <- notmuch [ "show", "--format=json", "--format-version=2"
@@ -152,188 +133,3 @@ setTag tag i = do
unsetTag :: String -> String -> IO LBS.ByteString
unsetTag tag i = do
notmuch [ "tag", "-" <> tag , "id:" <> i ]
-
-
-openMessage :: String -> IO ()
-openMessage i = do
- notmuch [ "tag", "+open" , "id:" <> i ] >> return ()
-
-
-closeMessage :: String -> IO ()
-closeMessage i = do
- notmuch [ "tag", "-open" , "id:" <> i ] >> return ()
-
-
-
-
-
-
----- | Neat 2-dimensional drawing of a tree.
---drawTree :: Tree String -> String
---drawTree = unlines . draw
---
----- | Neat 2-dimensional drawing of a forest.
---drawForest :: Forest String -> String
---drawForest = unlines . map drawTree
---
-draw :: Tree Message -> [String]
-draw (Node x ts0) = (show $ drawMessage x) : drawSubTrees ts0
- where
- drawSubTrees [] = []
- drawSubTrees [t] =
- -- "|" : shift "`- " " " (draw t)
- shift "`- " " " (draw t)
-
- drawSubTrees (t:ts) =
- -- "|" : shift "+- " "| " (draw t) ++ drawSubTrees ts
- shift "+- " "| " (draw t) ++ drawSubTrees ts
-
- shift first other = zipWith (++) (first : repeat other)
-
-
-indentMessageInit :: [String] -> [String]
-indentMessageInit [] = []
-indentMessageInit (s:ss) = (red "─╴" ++ s) : map (red " " ++) ss
-
-indentMessageLast :: [String] -> [String]
-indentMessageLast [] = []
-indentMessageLast (s:ss) = (red "┬╴" ++ s) : map (red "│ " ++) ss
-
-indentInit :: [String] -> [String]
-indentInit [] = []
-indentInit (s:ss) = (red "├╴" ++ s) : map (red "│ " ++) ss
-
-indentLast :: [String] -> [String]
-indentLast [] = []
-indentLast (s:ss) = (red "└╴" ++ s) : map (red " " ++) ss
-
-indentChildren :: [[String]] -> [[String]]
-indentChildren [] = []
-indentChildren ns = map indentInit (init ns) ++ [indentLast (last ns)]
-
-appLast :: [String] -> String -> [String]
-appLast ss s = init ss ++ [last ss ++ s]
-
-showTree' :: Tree Message -> [String]
-showTree' (Node n ns) =
- -- (if length ns == 0
- -- then indentMessageInit $ drawMessage n
- -- else indentMessageLast $ drawMessage n)
- drawMessage n
- ++
- concat (indentChildren (map showTree' ns))
-
--- | Show a 'Tree' using Unicode art
-showTree :: Tree Message -> String
-showTree = unlines . showTree'
-
-
-
-
-
-
-drawMessage :: Message -> [String]
-drawMessage Message{..} =
- ----unMessageID messageId
- --show messageTime
- -- -- <> " " <> T.unpack messageDateRel
- -- <> "\n" <> show (fromJust $ M.lookup "From" messageHeaders)
- -- <> "\n" <> show (fromJust $ M.lookup "Subject" messageHeaders)
- [ gray (unMessageID messageId)
- <> " " <> T.unpack (fromJust $ M.lookup "From" messageHeaders)
- <> " " <> gray (show messageDateRel)
- <> " " <> T.unpack (T.intercalate ", " $ map magenta messageTags)
- -- , T.unpack $ fromJust $ M.lookup "Subject" messageHeaders
- ]
- ++
- (if "open" `elem` messageTags
- then concat (map (map green . lines . drawMessagePart) messageBody)
- else [])
- --map drawMessagePart messageBody
-
-drawMessagePart :: MessagePart -> String
-drawMessagePart p = drawPartContent (partContent p)
-
-drawPartContent :: MessageContent -> String
-drawPartContent (ContentText t) = T.unpack t
---drawPartContent (ContentText t) = "ContentText"
-drawPartContent (ContentMultipart _) = "ContentMultipart"
-drawPartContent (ContentMsgRFC822 _) = "ContentMsgRFC822"
-
--- otherAuthors are non-matched authors in the same thread
-drawSearchResult :: SearchResult -> T.Text
-drawSearchResult SearchResult{..} = do
- let (matchedAuthors, otherAuthors) =
- case T.splitOn "| " searchAuthors of
- [a,b] -> (T.splitOn ", " a, T.splitOn ", " b)
- [a] -> (T.splitOn ", " a, [])
- x -> error $ "drawSearchResult: error " <> show x
-
- a' = map green matchedAuthors
- b' = map red otherAuthors
- --qa = maybe [] (T.splitOn " ") (searchQuery !! 0)
- --qb = maybe [] (T.splitOn " ") (searchQuery !! 1)
- ThreadID tid = searchThread
-
- (T.pack tid)
- -- <> " " <> (T.pack $ show $ searchTime)
- <> " " <> "[" <> (T.pack $ show searchMatched) <> "/"
- <> (T.pack $ show searchTotal) <> "]"
- <> " " <> searchDateRel
- <> " " <> searchSubject
- <> " " <> T.intercalate ", " (a' <> b')
- <> " " <> T.intercalate ", " (map magenta searchTags)
-
-
-
-
-red, green, magenta, gray :: (Monoid m, IsString m) => m -> m
-red = ("\ESC[31m"<>) . (<>"\ESC[m")
-green = ("\ESC[32m"<>) . (<>"\ESC[m")
-magenta = ("\ESC[35m"<>) . (<>"\ESC[m")
-gray = ("\ESC[30;1m"<>) . (<>"\ESC[39;22m")
-
-
-
-
- --case fromJSON c of
- -- Error e -> error e
- -- Success x -> return x
-
--- c <- hGetContents hout
---
--- let v =
---
---
--- putStrLn $ show c
-
--- let fixTags :: Char -> Char
--- fixTags '+' = '-'
--- fixTags '~' = '-'
--- fixTags c = c
--- let vStr = map fixTags $ words out !! 1
--- let vs = filter (\(_,r) -> r == "") $ readP_to_S parseVersion vStr
--- case vs of
--- ((v,_):_) -> return v
--- _ -> throw $ NotmuchError $ "Unable to parse version: " ++ vStr
-
-
-
--- | The version of notmuch
---notmuchVersion :: MonadIO m => m Version
---notmuchVersion = do
--- out <- liftIO $ readProcess "notmuch" ["--version"] ""
--- let fixTags :: Char -> Char
--- fixTags '+' = '-'
--- fixTags '~' = '-'
--- fixTags c = c
--- let vStr = map fixTags $ words out !! 1
--- let vs = filter (\(_,r) -> r == "") $ readP_to_S parseVersion vStr
--- case vs of
--- ((v,_):_) -> return v
--- _ -> throw $ NotmuchError $ "Unable to parse version: " ++ vStr
---
---
--- r <- createProcess (proc "ls" [])
---
---proc