Skip to content

Commit

Permalink
Nicer formatting for Search
Browse files Browse the repository at this point in the history
Resemble notmuch.el in human readable time differences
Split authors into matched and non-matched authors
  • Loading branch information
alip committed Jun 12, 2010
1 parent ccd3f5a commit 0cf258f
Show file tree
Hide file tree
Showing 4 changed files with 96 additions and 70 deletions.
23 changes: 12 additions & 11 deletions src/Qoropa/Buffer/Search.hs
Original file line number Diff line number Diff line change
Expand Up @@ -78,15 +78,16 @@ data StatusMessage = StatusMessage
}

data Attributes = Attributes
{ attrStatusBar :: Attr
, attrStatusMessage :: Attr
, attrFill :: Attr
, attrTime :: (Attr, Attr)
, attrCount :: (Attr, Attr)
, attrAuthor :: (Attr, Attr)
, attrSubject :: (Attr, Attr)
, attrTag :: (Attr, Attr)
, attrDefault :: (Attr, Attr)
{ attrStatusBar :: Attr
, attrStatusMessage :: Attr
, attrFill :: Attr
, attrTime :: (Attr, Attr)
, attrCount :: (Attr, Attr)
, attrAuthorMatched :: (Attr, Attr)
, attrAuthorNonMatched :: (Attr, Attr)
, attrSubject :: (Attr, Attr)
, attrTag :: (Attr, Attr)
, attrDefault :: (Attr, Attr)
}

data Theme = Theme
Expand Down Expand Up @@ -264,7 +265,7 @@ loadOne ref t = do
newestDate <- NM.threadNewestDate t

tags <- NM.threadTags t
taglist <- tagsToList tags
tagList <- tagsToList tags
NM.tagsDestroy tags

oldestDateRelative <- relativeTime oldestDate
Expand All @@ -277,7 +278,7 @@ loadOne ref t = do
, threadTotal = total
, threadAuthors = decodeString authors
, threadSubject = decodeString subject
, threadTags = taglist
, threadTags = tagList
}

writeIORef ref buf { bufferLines = bufferLines buf ++ [line]
Expand Down
87 changes: 52 additions & 35 deletions src/Qoropa/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -36,15 +36,16 @@ import qualified Data.Map as Map

import Graphics.Vty
( Event(..), Key(..), Modifier(..), Image
, string, char
, string, char, empty_image
, horiz_cat
, def_attr, with_back_color, with_fore_color, with_style
, bold
, black, white, magenta, yellow, cyan, red, green, blue
, bright_blue, bright_yellow
, bright_black, bright_blue, bright_yellow
)

import Qoropa.Util (beep)
import Qoropa.Notmuch (splitAuthors)
import Qoropa.Util (beep)
import {-# SOURCE #-} Qoropa.UI
( UI(..)
, redraw, exit
Expand Down Expand Up @@ -129,27 +130,30 @@ folderDrawStatusMessage attr msg = string (Folder.attrStatusMessage attr) (Folde

defaultSearchAttributes :: Search.Attributes
defaultSearchAttributes = Search.Attributes
{ Search.attrStatusBar = def_attr `with_back_color` green `with_fore_color` black
, Search.attrStatusMessage = def_attr `with_fore_color` bright_yellow
, Search.attrFill = def_attr `with_fore_color` cyan
, Search.attrTime = ( def_attr `with_fore_color` white
, def_attr `with_back_color` yellow `with_fore_color` black
)
, Search.attrCount = ( def_attr `with_fore_color` white
, def_attr `with_back_color` yellow `with_fore_color` black
)
, Search.attrAuthor = ( def_attr `with_fore_color` green
, def_attr `with_back_color` yellow `with_fore_color` blue `with_style` bold
)
, Search.attrSubject = ( def_attr `with_fore_color` white
, def_attr `with_back_color` yellow `with_fore_color` blue
)
, Search.attrTag = ( def_attr `with_fore_color` magenta
, def_attr `with_back_color` yellow `with_fore_color` blue `with_style` bold
)
, Search.attrDefault = ( def_attr
, def_attr `with_back_color` yellow
)
{ Search.attrStatusBar = def_attr `with_back_color` green `with_fore_color` black
, Search.attrStatusMessage = def_attr `with_fore_color` bright_yellow
, Search.attrFill = def_attr `with_fore_color` cyan
, Search.attrTime = ( def_attr `with_fore_color` white
, def_attr `with_back_color` yellow `with_fore_color` black
)
, Search.attrCount = ( def_attr `with_fore_color` white
, def_attr `with_back_color` yellow `with_fore_color` black
)
, Search.attrAuthorMatched = ( def_attr `with_fore_color` green
, def_attr `with_back_color` yellow `with_fore_color` blue `with_style` bold
)
, Search.attrAuthorNonMatched = ( def_attr `with_fore_color` bright_black
, def_attr `with_back_color` yellow `with_fore_color` bright_black
)
, Search.attrSubject = ( def_attr `with_fore_color` white
, def_attr `with_back_color` yellow `with_fore_color` blue
)
, Search.attrTag = ( def_attr `with_fore_color` magenta
, def_attr `with_back_color` yellow `with_fore_color` blue `with_style` bold
)
, Search.attrDefault = ( def_attr
, def_attr `with_back_color` yellow
)
}

defaultSearchTheme :: Search.Theme
Expand All @@ -170,7 +174,7 @@ searchDrawLine attr selected line =
horiz_cat $ intersperse (char myDefaultAttribute ' ')
[ string myTimeAttribute myTimeFormat
, string myCountAttribute myCountFormat
, string myAuthorAttribute myAuthorFormat
, myAuthorString
, string mySubjectAttribute mySubjectFormat
, string myTagAttribute myTagFormat
]
Expand All @@ -181,23 +185,36 @@ searchDrawLine attr selected line =
myTimeAttribute = if selected /= Search.lineIndex line
then fst $ Search.attrTime attr
else snd $ Search.attrTime attr
myCountAttribute = if selected /= Search.lineIndex line
myCountAttribute = if selected /= Search.lineIndex line
then fst $ Search.attrCount attr
else snd $ Search.attrCount attr
myAuthorAttribute = if selected /= Search.lineIndex line
then fst $ Search.attrAuthor attr
else snd $ Search.attrAuthor attr
mySubjectAttribute = if selected /= Search.lineIndex line
then fst $ Search.attrSubject attr
else snd $ Search.attrSubject attr
myTagAttribute = if selected /= Search.lineIndex line
myTagAttribute = if selected /= Search.lineIndex line
then fst $ Search.attrTag attr
else snd $ Search.attrTag attr
myTimeFormat = printf "%-s" (snd $ Search.threadNewestDate line)
myCountFormat = printf "[%d/%-d]" (Search.threadMatched line) (Search.threadTotal line)
myAuthorFormat = printf "%-10s" (Search.threadAuthors line)
mySubjectFormat = printf "%-20s" (Search.threadSubject line)
myTagFormat = join " " $ map ('+' :) (Search.threadTags line)
myTimeFormat = printf "%15s" (snd $ Search.threadNewestDate line)
myCountFormat = printf "%-7s" ( "[" ++ show (Search.threadMatched line) ++
"/" ++ show (Search.threadTotal line) ++
"]"
)
mySubjectFormat = printf "%-20s" (Search.threadSubject line)
myTagFormat = join " " $ map ('+' :) (Search.threadTags line)

myAuthorMatchedAttribute = if selected /= Search.lineIndex line
then fst $ Search.attrAuthorMatched attr
else snd $ Search.attrAuthorMatched attr
myAuthorNonMatchedAttribute = if selected /= Search.lineIndex line
then fst $ Search.attrAuthorNonMatched attr
else snd $ Search.attrAuthorNonMatched attr
(myAuthorMatchedFormat, myAuthorNonMatchedFormat) = splitAuthors (Search.threadAuthors line) 17
myAuthorMatchedString = string myAuthorMatchedAttribute myAuthorMatchedFormat
myAuthorNonMatchedString = string myAuthorNonMatchedAttribute myAuthorNonMatchedFormat
mySplitChar = if not (null myAuthorNonMatchedFormat)
then char myAuthorMatchedAttribute ','
else empty_image
myAuthorString = horiz_cat [myAuthorMatchedString, mySplitChar, myAuthorNonMatchedString]

searchDrawStatusBar :: Search.Attributes -> Search.StatusBar -> Image
searchDrawStatusBar attr bar =
Expand Down
22 changes: 20 additions & 2 deletions src/Qoropa/Notmuch.hs
Original file line number Diff line number Diff line change
Expand Up @@ -18,11 +18,29 @@
-}

module Qoropa.Notmuch
( tagsToList
( splitAuthors
, tagsToList
) where

import Data.String.Utils (split)
import Codec.Binary.UTF8.String (decodeString)
import Email.Notmuch (Tags, Tag, tagsValid, tagsGet, tagsMoveToNext)
import Email.Notmuch (Tags, Tag, tagsValid, tagsGet, tagsMoveToNext)

splitAuthors :: String -> Int -> (String, String)
splitAuthors s i =
(m', nm')
where
len = length s
trs = take i s
trsp = split "|" trs
m = trsp !! 0
nm = if length trsp > 1 then trsp !! 1 else []
nm' = if not (null nm)
then (if len > i then nm ++ "..." else nm ++ (replicate (i + 3 - len) ' '))
else nm
m' = if null nm
then (if len > i then m ++ "..." else m ++ (replicate (i + 3 - len) ' '))
else m

tagsToList :: Tags -> IO [Tag]
tagsToList ts = do
Expand Down
34 changes: 12 additions & 22 deletions src/Qoropa/Util.hs
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,6 @@ import Control.Exception (catch, bracket, SomeException(..))
import Control.Monad (filterM)
import Data.List ((\\))

import Data.Char (isSpace)
import Data.Time
( TimeZone, UTCTime, NominalDiffTime
, diffUTCTime, utcToLocalTime, formatTime
Expand Down Expand Up @@ -73,7 +72,7 @@ humanReadableTimeDiff :: TimeZone -> UTCTime -> UTCTime -> String
humanReadableTimeDiff tz curTime oldTime =
helper diff
where
diff = diffUTCTime curTime oldTime
diff = diffUTCTime curTime oldTime

minutes :: NominalDiffTime -> Double
minutes n = realToFrac $ n / 60
Expand All @@ -84,9 +83,6 @@ humanReadableTimeDiff tz curTime oldTime =
days :: NominalDiffTime -> Double
days n = (hours n) / 24

weeks :: NominalDiffTime -> Double
weeks n = (days n) / 7

years :: NominalDiffTime -> Double
years n = (days n) / 365

Expand All @@ -98,23 +94,17 @@ humanReadableTimeDiff tz curTime oldTime =

old = utcToLocalTime tz oldTime

trim = f . f
where f = reverse . dropWhile isSpace

dow = trim $! formatTime defaultTimeLocale "%l:%M %p on %A" old
thisYear = trim $! formatTime defaultTimeLocale "%b %e" old
previousYears = trim $! formatTime defaultTimeLocale "%b %e, %Y" old

helper !d | d < 1 = "One second ago"
| d < 60 = i2s d ++ " seconds ago"
| minutes d < 2 = "One minute ago"
| minutes d < 60 = i2s (minutes d) ++ " minutes ago"
| hours d < 2 = "One hour ago"
| hours d < 24 = i2s (hours d) ++ " hours ago"
| days d < 5 = dow
| days d < 10 = i2s (days d) ++ " days ago"
| weeks d < 2 = i2s (weeks d) ++ " week ago"
| weeks d < 5 = i2s (weeks d) ++ " weeks ago"
today = formatTime defaultTimeLocale "Today %R" old
yesterday = formatTime defaultTimeLocale "Yest. %R" old
dayOfWeek = formatTime defaultTimeLocale "%a. %R" old
thisYear = formatTime defaultTimeLocale "%B %d" old
previousYears = formatTime defaultTimeLocale "%F" old

helper !d | minutes d < 2 = "One min. ago"
| minutes d < 60 = i2s (minutes d) ++ " mins. ago"
| hours d < 24 = today
| hours d < 48 = yesterday
| days d < 5 = dayOfWeek
| years d < 1 = thisYear
| otherwise = previousYears

Expand Down

0 comments on commit 0cf258f

Please sign in to comment.