Select text color according to current background color

stack.yaml

@@ -10,6 +10,8 @@ packages:
 extra-deps:
   - aeson-1.5.6.0
 
+  - ansi-terminal-0.11.4
+
   - iso8601-duration-0.1.1.0
 
   - portable-lines-0.1

stack.yaml.lock

@@ -5,56 +5,63 @@
 
 packages:
 - completed:
+    hackage: aeson-1.5.6.0@sha256:5003bb6fd260d2e2d5a51dee2bf5c8e8f29e4e0e0288fef805c22dcc80ecab06,6788
     pantry-tree:
       sha256: 1f61b87807bfb4362a978a492e2f17be9e3ebfe32f983ee49863ddde970b32ce
       size: 37981
-    hackage: aeson-1.5.6.0@sha256:5003bb6fd260d2e2d5a51dee2bf5c8e8f29e4e0e0288fef805c22dcc80ecab06,6788
   original:
     hackage: aeson-1.5.6.0
 - completed:
+    hackage: ansi-terminal-0.11.4@sha256:410737137c798e23339a08435a5511785ebf1db08700e37debbd7801cf73fc82,3584
+    pantry-tree:
+      sha256: 49bc6ef92292ee8b663a40cf5170af1efaaa4ed84155b65ad41eabf1faf9b18f
+      size: 1462
+  original:
+    hackage: ansi-terminal-0.11.4
+- completed:
+    hackage: iso8601-duration-0.1.1.0@sha256:0e9e7531e71b693c20115198186a0280aa3631dc29da226e84e55f0984bec1af,2210
     pantry-tree:
       sha256: 183be7ad7fded29b7dbf94bd57a58755abeab8f1d1d237ac47f95543a84a8ae7
       size: 569
-    hackage: iso8601-duration-0.1.1.0@sha256:0e9e7531e71b693c20115198186a0280aa3631dc29da226e84e55f0984bec1af,2210
   original:
     hackage: iso8601-duration-0.1.1.0
 - completed:
+    hackage: portable-lines-0.1@sha256:21c3b905888a4b43f957cd8e8cdf2af00942bb161aa19a6b20db18b661de0510,1552
     pantry-tree:
       sha256: 2eeb1d9aefe4fb172dc56baa75f09aaaac824799d926922b4673188293f9f95c
       size: 371
-    hackage: portable-lines-0.1@sha256:21c3b905888a4b43f957cd8e8cdf2af00942bb161aa19a6b20db18b661de0510,1552
   original:
     hackage: portable-lines-0.1
 - completed:
-    sha256: 42e6ebee9791e89b9490c3f92003e83a92401ed2635209b7d8a0f5da5d9b37f0
     name: ulid
-    size: 10636
-    url: https://github.com/ad-si/ulid/archive/443b5d74d0f2abdc3879e8338cc4497d68e640df.tar.gz
     pantry-tree:
       sha256: a6d5edf44e0c3dbe23454e11b6c7db52373f852fe5e2ade6d23b9842a13be883
       size: 1157
+    sha256: 42e6ebee9791e89b9490c3f92003e83a92401ed2635209b7d8a0f5da5d9b37f0
+    size: 10636
+    url: https://github.com/ad-si/ulid/archive/443b5d74d0f2abdc3879e8338cc4497d68e640df.tar.gz
     version: 0.3.1.0
   original:
     url: https://github.com/ad-si/ulid/archive/443b5d74d0f2abdc3879e8338cc4497d68e640df.tar.gz
 - completed:
-    sha256: a003b0d5906248468b886feea1536febc8b91946e634c4321b2f5c1c42744385
     name: simple-sql-parser
-    size: 132157
-    url: https://github.com/JakeWheat/simple-sql-parser/archive/00433a26e8303c9e61359f406da5a2dbf1293fc8.tar.gz
     pantry-tree:
       sha256: 8ea116a325adc8001f2f0c52ca5ece1e8d00f5ec44b7bc38de8907305fd1f37b
       size: 3477
+    sha256: a003b0d5906248468b886feea1536febc8b91946e634c4321b2f5c1c42744385
+    size: 132157
+    url: https://github.com/JakeWheat/simple-sql-parser/archive/00433a26e8303c9e61359f406da5a2dbf1293fc8.tar.gz
     version: 0.5.0
   original:
     url: https://github.com/JakeWheat/simple-sql-parser/archive/00433a26e8303c9e61359f406da5a2dbf1293fc8.tar.gz
 - completed:
-    sha256: 0642bfda8aaaa84477e030e26770a388e4facbce25f98b8781820c8b82f280e5
     name: protolude
-    size: 33781
-    url: https://github.com/protolude/protolude/archive/3e249724fd0ead27370c8c297b1ecd38f92cbd5b.tar.gz
     pantry-tree:
       sha256: 685ed0191298da9540e772ffa746eb078d4f4a77ed8012a9933d3c79644b1054
       size: 3146
+    sha256: 0642bfda8aaaa84477e030e26770a388e4facbce25f98b8781820c8b82f280e5
+    size: 33781
+    url: https://github.com/protolude/protolude/archive/3e249724fd0ead27370c8c297b1ecd38f92cbd5b.tar.gz
     version: 0.3.1
   original:
     url: https://github.com/protolude/protolude/archive/3e249724fd0ead27370c8c297b1ecd38f92cbd5b.tar.gz

tasklite-core/app/Main.hs

@@ -27,7 +27,7 @@ import GHC.IO.Encoding (setLocaleEncoding, utf8)
 import GitHash
 import Options.Applicative
 import Options.Applicative.Help.Core (parserHelp)
-import Paths_tasklite_core ()
+import Paths_tasklite_core ( version )  -- Special module provided by Cabal
 import System.Directory
   ( createDirectoryIfMissing
   , executable
@@ -46,7 +46,6 @@ import qualified Database.SQLite.Simple as SQLite
 import Config (Config(..), HookSet(..), HooksConfig(..), addHookFilesToConfig)
 import ImportExport
 import Migrations
-import Paths_tasklite_core (version)  -- Special module provided by Cabal
 import Utils
 
 

tasklite-core/package.yaml

@@ -21,12 +21,14 @@ description: |
 
 dependencies:
   - aeson
+  - ansi-terminal
   - base >= 4.7 && < 5
   - beam-core
   - beam-migrate
   - beam-sqlite
   - bytestring
   - cassava
+  - colour
   - directory
   - file-embed
   - filepath

tasklite-core/source/Config.hs

@@ -252,7 +252,7 @@ defaultConfig = Config
   { tableName = "tasks"
   , idStyle = color Green
   , priorityStyle = color Magenta
-  , dateStyle = colorDull Black
+  , dateStyle = color Black
   , bodyStyle = color White
   , bodyClosedStyle = color Black
   , closedStyle = colorDull Black

tasklite-core/source/Lib.hs

@@ -1550,13 +1550,13 @@ formatTaskLine conf now taskUlidWidth task =
         annotate (dateStyle conf) (pretty taskDate) :
         (pretty $ case FullTask.review_utc task >>= parseUtc of
           Nothing -> "" :: Text
-          Just date_ -> if date_ < now then "🔎" else "") :
-        (if dueIn mempty { durationHours = 24 } && isOpen
-          then "⚠️️  "
-          else "") <>
-          (if dueIn mempty && isOpen
-            then annotate (color Red) (reflow body)
-            else grayOutIfDone (reflow body)) :
+          Just date_ -> if date_ < now then "🔎 " else "")
+          <> (if dueIn mempty { durationHours = 24 } && isOpen
+            then "⚠️️  "
+            else "") <>
+            (if dueIn mempty && isOpen
+              then annotate (color Red) (reflow body)
+              else grayOutIfDone (reflow body)) :
         annotate (dueStyle conf) (pretty dueUtcMaybe) :
         annotate (closedStyle conf) (pretty closedUtcMaybe) :
         hsep (tags <&> (formatTag conf)) :
@@ -1622,7 +1622,7 @@ headTasks conf now connection = do
     \where closed_utc is null \
     \order by priority desc, due_utc asc, ulid desc \
     \limit " <> show (headCount conf)
-  pure $ formatTasks conf now tasks
+  formatTasksColor conf now tasks
 
 
 newTasks :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle)
@@ -1631,7 +1631,7 @@ newTasks conf now connection = do
     "select * from `tasks_view` \
     \where closed_utc is null \
     \order by `ulid` desc limit " <> show (headCount conf)
-  pure $ formatTasks conf now tasks
+  formatTasksColor conf now tasks
 
 
 listOldTasks :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle)
@@ -1640,7 +1640,7 @@ listOldTasks conf now connection = do
     "select * from `tasks_view` \
     \where closed_utc is null \
     \order by `ulid` asc limit " <> show (headCount conf)
-  pure $ formatTasks conf now tasks
+  formatTasksColor conf now tasks
 
 
 openTasks :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle)
@@ -1649,7 +1649,7 @@ openTasks conf now connection = do
     "select * from `tasks_view` \
     \where closed_utc is null \
     \order by priority desc, due_utc asc, ulid desc"
-  pure $ formatTasks conf now tasks
+  formatTasksColor conf now tasks
 
 
 modifiedTasks
@@ -1680,7 +1680,7 @@ modifiedTasks conf now connection listModifiedFlag = do
         AllItems -> tasks
         ModifiedItemsOnly -> filterModified tasks
 
-  pure $ formatTasks conf now filteredTasks
+  formatTasksColor conf now filteredTasks
 
 
 overdueTasks :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle)
@@ -1689,7 +1689,7 @@ overdueTasks conf now connection = do
     "select * from `tasks_view` \
     \where closed_utc is null and due_utc < datetime('now') \
     \order by priority desc, due_utc asc, ulid desc"
-  pure $ formatTasks conf now tasks
+  formatTasksColor conf now tasks
 
 
 doneTasks :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle)
@@ -1698,7 +1698,7 @@ doneTasks conf now connection = do
     "select * from tasks_view \
     \where closed_utc is not null and state is 'Done' \
     \order by closed_utc desc limit " <> show (headCount conf)
-  pure $ formatTasks conf now tasks
+  formatTasksColor conf now tasks
 
 
 obsoleteTasks :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle)
@@ -1707,7 +1707,7 @@ obsoleteTasks conf now connection = do
     "select * from tasks_view \
     \where closed_utc is not null and state is 'Obsolete' \
     \order by ulid desc limit " <> show (headCount conf)
-  pure $ formatTasks conf now tasks
+  formatTasksColor conf now tasks
 
 
 deletableTasks :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle)
@@ -1716,7 +1716,7 @@ deletableTasks conf now connection = do
     "select * from tasks_view \
     \where closed_utc is not null and state is 'Deletable' \
     \order by ulid desc limit " <> show (headCount conf)
-  pure $ formatTasks conf now tasks
+  formatTasksColor conf now tasks
 
 
 listRepeating :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle)
@@ -1726,7 +1726,7 @@ listRepeating conf now connection = do
     \where repetition_duration is not null \
     \order by repetition_duration desc"
 
-  pure $ formatTasks conf now tasks
+  formatTasksColor conf now tasks
 
 
 listRecurring :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle)
@@ -1736,7 +1736,7 @@ listRecurring conf now connection = do
     \where recurrence_duration is not null \
     \order by recurrence_duration desc"
 
-  pure $ formatTasks conf now tasks
+  formatTasksColor conf now tasks
 
 
 listReady :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle)
@@ -1749,7 +1749,7 @@ listReady conf now connection = do
     \order by priority desc, due_utc asc, ulid desc \
     \limit " <> show (headCount conf)
 
-  pure $ formatTasks conf now tasks
+  formatTasksColor conf now tasks
 
 
 listWaiting :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle)
@@ -1760,15 +1760,14 @@ listWaiting conf now connection = do
       \and waiting_utc is not null \
       \and (review_utc > datetime('now') or review_utc is null) \
     \order by waiting_utc desc"
-
-  pure $ formatTasks conf now tasks
+  formatTasksColor conf now tasks
 
 
 listAll :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle)
 listAll conf now connection = do
   tasks <- query_ connection
     "select * from tasks_view order by ulid asc"
-  pure $ formatTasks conf now tasks
+  formatTasksColor conf now tasks
 
 
 listNoTag :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle)
@@ -1777,7 +1776,7 @@ listNoTag conf now connection = do
     "select * from tasks_view \
     \where closed_utc is null and tags is null \
     \order by priority desc, due_utc asc, ulid desc"
-  pure $ formatTasks conf now tasks
+  formatTasksColor conf now tasks
 
 
 getWithTag :: Connection -> Maybe DerivedState -> [Text] -> IO [FullTask]
@@ -1817,14 +1816,14 @@ getWithTag connection stateMaybe tags = do
 listWithTag :: Config -> DateTime -> Connection -> [Text] -> IO (Doc AnsiStyle)
 listWithTag conf now connection tags = do
   tasks <- getWithTag connection Nothing tags
-  pure $ formatTasks conf now tasks
+  formatTasksColor conf now tasks
 
 
 queryTasks :: Config -> DateTime -> Connection -> Text -> IO (Doc AnsiStyle)
 queryTasks conf now connection sqlQuery = do
   tasks <- query_ connection $ Query $
     "select * from `tasks_view` where " <> sqlQuery
-  pure $ formatTasks conf now tasks
+  formatTasksColor conf now tasks
 
 
 runSql :: Config -> Text -> IO (Doc AnsiStyle)
@@ -1954,7 +1953,7 @@ runFilter conf now connection exps = do
       then
         dieWithError $ vsep (fmap ppInvalidFilter errors)
       else
-        pure $ formatTasks conf now tasks
+        formatTasksColor conf now tasks
 
     _ -> dieWithError filterHelp
 
@@ -2010,6 +2009,12 @@ formatTasks conf now tasks  =
       line
 
 
+formatTasksColor :: Config -> DateTime -> [FullTask] -> IO (Doc AnsiStyle)
+formatTasksColor conf now tasks = do
+  confNorm <- applyColorMode conf
+  pure $ formatTasks confNorm now tasks
+
+
 getProgressBar :: Integer -> Double -> Doc AnsiStyle
 getProgressBar maxWidthInChars progress =
   let

tasklite-core/source/Utils.hs

@@ -8,15 +8,21 @@ import Protolude as P
 
 import Data.Text as T
 import Prettyprinter hiding ((<>))
+import Data.Colour.RGBSpace (RGB(..))
 import Data.Time (addUTCTime, UTCTime, ZonedTime, zonedTimeToUTC)
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
 import Data.Hourglass
 import Prettyprinter.Render.Terminal
 import Data.ULID
 import Data.ULID.Random
 import Data.ULID.TimeStamp
+import System.Console.ANSI (
+    ConsoleLayer(..),
+    getLayerColor,
+  )
 import System.Process
 
+
 import Base32
 import Config
 
@@ -206,3 +212,26 @@ executeHooks stdinText hooks = do
     <&> T.pack
     & T.unlines
     & pretty
+
+
+
+applyColorMode :: Config -> IO Config
+applyColorMode conf = do
+  layerColorBgMb <- getLayerColor Background
+
+  let
+    calcLuminance :: RGB Word16 -> Double
+    calcLuminance (RGB {..}) =
+      (0.3 * fromIntegral channelRed +
+      0.6 * fromIntegral channelGreen +
+      0.1 * fromIntegral channelBlue) / 65536
+
+    isLightMode = layerColorBgMb
+      <&> calcLuminance
+      & fromMaybe 0
+      & (> 0.5)
+
+  pure $
+    if isLightMode
+    then conf { bodyStyle = colorDull Black }
+    else conf