{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Use maybe" #-}

{-|
Functions to create, update, and delete tasks / tags / notes
-}
module Lib where

import Protolude (
  Applicative (liftA2, pure),
  Bool (..),
  Char,
  Double,
  Down (Down),
  Either (Left, Right),
  Eq (..),
  FilePath,
  Float,
  Floating (logBase),
  Fractional ((/)),
  Functor (fmap),
  IO,
  Int,
  Int64,
  Integer,
  Integral (toInteger),
  Maybe (..),
  Monad (return, (>>=)),
  MonadIO (liftIO),
  Monoid (mempty),
  Num (abs, fromInteger, (*), (+), (-)),
  Ord (compare, max, (<), (>)),
  Read,
  RealFrac (ceiling, floor),
  Semigroup ((<>)),
  Show,
  Text,
  catMaybes,
  const,
  decodeUtf8,
  either,
  encodeUtf8,
  exitFailure,
  forM,
  forM_,
  fromIntegral,
  fromMaybe,
  fst,
  getArgs,
  identity,
  isJust,
  isNothing,
  isSpace,
  listToMaybe,
  maybe,
  maybeToEither,
  not,
  on,
  otherwise,
  realToFrac,
  show,
  snd,
  sortBy,
  sortOn,
  stderr,
  unlines,
  unwords,
  ($),
  ($>),
  (&),
  (&&),
  (.),
  (<$>),
  (<&>),
  (<=),
  (||),
 )
import Protolude qualified as P

import Control.Applicative ((<|>))
import Control.Arrow ((>>>))
import Data.Aeson as Aeson (KeyValue ((.=)), encode, object)
import Data.Coerce (coerce)
import Data.Generics (Data, constrFields, toConstr)
import Data.Hourglass (
  DateTime (dtTime),
  Duration (durationHours, durationMinutes),
  ISO8601_Date (ISO8601_Date),
  Minutes (Minutes),
  Seconds (Seconds),
  Time (timeFromElapsedP),
  TimeOfDay (todNSec),
  timeAdd,
  timeDiff,
  timePrint,
 )
import Data.List (nub)
import Data.Text qualified as T
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Encoding qualified as TL
import Data.Time.Clock (UTCTime)
import Data.Time.ISO8601.Duration qualified as Iso
import Data.ULID (ULID, getULID)
import Data.Yaml qualified as Yaml
import Database.SQLite.Simple (
  Connection,
  Error (ErrorConstraint),
  FromRow (..),
  NamedParam ((:=)),
  Only (Only),
  Query (Query),
  SQLData (SQLNull, SQLText),
  SQLError (sqlError),
  ToRow,
  changes,
  execute,
  executeNamed,
  field,
  open,
  query,
  queryNamed,
  query_,
  toRow,
  withConnection,
 )
import Database.SQLite.Simple.QQ (sql)
import Numeric (showFFloat)
import Prettyprinter as Pp (
  Doc,
  Pretty (pretty),
  align,
  annotate,
  concatWith,
  dquotes,
  fill,
  hang,
  hardline,
  hsep,
  indent,
  line,
  punctuate,
  vcat,
  vsep,
  (<+>),
 )
import Prettyprinter.Render.Terminal (
  AnsiStyle,
  Color (Black, Green, Red, Yellow),
  bold,
  color,
  hPutDoc,
  underlined,
 )
import Prettyprinter.Util (reflow)
import System.Directory (createDirectoryIfMissing)
import System.FilePath ((</>))
import System.Posix.User (getEffectiveUserName)
import System.Process (readProcess)
import Text.Fuzzily qualified as Fuzzily
import Text.ParserCombinators.ReadP (
  ReadP,
  char,
  eof,
  munch,
  munch1,
  readP_to_S,
  sepBy1,
  skipSpaces,
  string,
  (<++),
 )
import Text.Printf (printf)
import Time.System (dateCurrent, timeCurrentP)

import Config (
  Column (..),
  Config (
    bodyClosedStyle,
    bodyStyle,
    bodyWidth,
    closedStyle,
    columns,
    dataDir,
    dateStyle,
    dateWidth,
    dbName,
    dueStyle,
    headCount,
    hooks,
    idStyle,
    prioWidth,
    priorityStyle,
    progressBarWidth,
    tableName,
    tagStyle,
    utcFormat,
    utcFormatShort
  ),
  HookSet (post, pre),
  HooksConfig (add),
  defaultConfig,
 )
import Control.Monad.Catch (catchAll, catchIf)
import FullTask (
  FullTask (
    awake_utc,
    body,
    closed_utc,
    due_utc,
    group_ulid,
    metadata,
    modified_utc,
    notes,
    priority,
    ready_utc,
    recurrence_duration,
    repetition_duration,
    review_utc,
    tags,
    ulid,
    user,
    waiting_utc
  ),
  cpTimesAndState,
  selectQuery,
 )
import Hooks (HookResult (message, task), executeHooks, formatHookResult)
import ImportTask (
  ImportTask (ImportTask, notes, tags, task),
  importTaskToFullTask,
  setMissingFields,
 )
import Note (Note (body, ulid))
import Prettyprinter.Internal.Type (Doc (Empty))
import SqlUtils (quoteKeyword, quoteText)
import Task (
  DerivedState (IsOpen),
  Task,
  TaskState (..),
  derivedStateToQuery,
  emptyTask,
  getStateHierarchy,
  textToDerivedState,
 )
import Task qualified
import TaskToNote (TaskToNote (..))
import TaskToTag (TaskToTag (..))
import Utils (
  IdText,
  ListModifiedFlag (..),
  applyColorMode,
  bgColrDull,
  colr,
  colrDull,
  countChar,
  dateTimeToUtcTime,
  formatElapsedP,
  numDigits,
  parseUlidText,
  parseUtc,
  setDateTime,
  ulidTextToDateTime,
  utcFormatReadable,
  utcTimeToDateTime,
  vsepCollapse,
  (<$$>),
  (<++>),
 )


noTasksWarning :: Text
noTasksWarning =
  "No tasks available. "
    <> "Run `tasklite help` to learn how to create tasks."


newtype NumRows = NumRows Integer
  deriving (Eq, Ord, Read, Show)


instance FromRow NumRows where
  fromRow = NumRows <$> field


getDbPath :: Config -> IO FilePath
getDbPath conf = do
  pure $ conf.dataDir </> conf.dbName


setupConnection :: Config -> IO Connection
setupConnection conf = do
  createDirectoryIfMissing True $ dataDir conf
  open $ conf.dataDir </> conf.dbName


execWithConn :: Config -> (Connection -> IO a) -> IO a
execWithConn conf func = do
  createDirectoryIfMissing True $ dataDir conf
  withConnection
    (conf.dataDir </> conf.dbName)
    func


-- | Get fields names of record (empty list if not record constructor)
getRecordFields :: (Data object) => object -> [Text]
getRecordFields =
  toConstr >>> constrFields >>> fmap T.pack


insertRecord :: (ToRow r, Data r) => Text -> Connection -> r -> IO ()
insertRecord tableName connection record = do
  let recordFields = record & getRecordFields
  execute
    connection
    ( Query $
        "INSERT INTO "
          <> tableName
          <> "("
          <> (recordFields & T.intercalate ",\n")
          <> ") VALUES ("
          <> ((recordFields $> "?") & T.intercalate ",\n")
          <> ")"
    )
    (toRow record)


getUpdateAssignments :: Task -> Text
getUpdateAssignments task =
  task
    & getRecordFields
    <&> (<> " = ?")
    & T.intercalate ", "


updateTask :: Connection -> Task -> IO ()
updateTask connection task = do
  execute
    connection
    ( Query $
        " UPDATE tasks SET "
          <> getUpdateAssignments task
          <> " WHERE ulid == ?"
    )
    (toRow task <> [SQLText task.ulid])


handleTagDupError :: Config -> Text -> (Applicative f) => e -> f (Doc AnsiStyle)
handleTagDupError conf tag _exception =
  pure $
    annotate (colr conf Yellow) $
      "⚠️ Tag " <> dquotes (pretty tag) <> " is already assigned"


insertTags ::
  Config -> Connection -> Maybe DateTime -> Task -> [Text] -> IO (Doc AnsiStyle)
insertTags conf connection mbCreatedUtc task tags = do
  let uniqueTags = nub tags
  taskToTags <- forM uniqueTags $ \tag -> do
    newUlid <- getULID
    pure $
      TaskToTag
        { ulid =
            mbCreatedUtc
              <&> setDateTime newUlid
              & fromMaybe newUlid
              & show
              & T.toLower
        , task_ulid = task.ulid
        , tag = tag
        }

  -- TODO: Insert all tags at once
  insertWarnings <- P.forM taskToTags $ \taskToTag ->
    catchIf
      -- TODO: Find out why it's not `ErrorConstraintUnique`
      (\(err :: SQLError) -> err.sqlError == ErrorConstraint)
      (insertRecord "task_to_tag" connection taskToTag P.>> pure "")
      (handleTagDupError conf taskToTag.tag)

  pure $ vsepCollapse insertWarnings


insertNotes ::
  Config ->
  Connection ->
  Maybe DateTime ->
  Task ->
  [Note] ->
  IO (Doc AnsiStyle)
insertNotes conf connection mbCreatedUtc task notes = do
  let uniqueNotes = nub notes
  taskToNotes <- forM uniqueNotes $ \theNote -> do
    newUlid <- getULID
    pure $
      TaskToNote
        { ulid =
            theNote.ulid
              & parseUlidText
              & fromMaybe newUlid
              & case mbCreatedUtc of
                Nothing -> P.identity
                Just createdUtc -> P.flip setDateTime createdUtc
              & show @ULID
              & T.toLower
        , task_ulid = task.ulid
        , note = theNote.body
        }

  insertWarnings <- P.forM taskToNotes $ \taskToNote ->
    catchAll
      (insertRecord "task_to_note" connection taskToNote P.>> pure "")
      ( \exception ->
          pure $
            annotate (colr conf Yellow) $
              "⚠️ Note "
                <> dquotes (pretty taskToNote.note)
                <> " could not be inserted"
                <+> "ERROR:"
                <+> pretty (show exception :: Text)
      )

  pure $ vsepCollapse insertWarnings


-- | Tuple is (Maybe createdUtc, noteBody)
insertNoteTuples :: Connection -> Task -> [(Maybe DateTime, Text)] -> IO ()
insertNoteTuples connection task notes = do
  taskToNotes <- forM notes $ \(mbCreatedUtc, noteBody) -> do
    noteUlid <- getULID
    pure $
      TaskToNote
        { ulid =
            mbCreatedUtc
              <&> setDateTime noteUlid
              & fromMaybe noteUlid
              & show
              & T.toLower
        , task_ulid = task.ulid
        , note = noteBody
        }

  forM_ taskToNotes $ \taskToNote ->
    insertRecord "task_to_note" connection taskToNote


formatUlid :: IO ULID -> IO Text
formatUlid =
  fmap (T.toLower . show)


{-| Parses the body of the tasks and extracts all meta data
 | Returns a tuple (body, tags, dueUtcMb, createdUtcMb)
 TODO: Replace with parsec implementation
-}
parseTaskBody :: [Text] -> (Text, [Text], Maybe Text, Maybe DateTime)
parseTaskBody bodyWords =
  let
    isTag = ("+" `T.isPrefixOf`)
    isDueUtc = ("due:" `T.isPrefixOf`)
    isCreatedUtc = ("created:" `T.isPrefixOf`)
    isMeta word = isTag word || isDueUtc word || isCreatedUtc word
    -- Handle case when word is actually a text
    bodyWordsReversed = bodyWords & T.unwords & T.words & P.reverse
    body =
      bodyWordsReversed
        & P.dropWhile isMeta
        & P.reverse
        & unwords
    metadata =
      bodyWordsReversed
        & P.takeWhile isMeta
        & P.reverse
    tags = fmap (T.replace "+" "") (P.filter isTag metadata)
    dueUtcMb =
      metadata
        & P.filter isDueUtc
        <&> T.replace "due:" ""
        & P.lastMay
          >>= parseUtc
        <&> (timePrint utcFormatReadable >>> T.pack)
    createdUtcMb =
      metadata
        & P.filter isCreatedUtc
        <&> T.replace "created:" ""
        & P.lastMay
          >>= parseUtc
  in
    (body, tags, dueUtcMb, createdUtcMb)


-- | Get (ulid, modified_utc, effectiveUserName) from the environment
getTriple :: Config -> IO (ULID, Text, [Char])
getTriple conf = do
  ulid <- getULID
  -- TODO: Set via a SQL trigger
  modified_utc <- formatElapsedP conf timeCurrentP
  effectiveUserName <- getEffectiveUserName

  pure (ulid, modified_utc, effectiveUserName)


addEmptyTask :: Config -> Connection -> IO Task
addEmptyTask conf conn = do
  (ulid, modified_utc, effectiveUserName) <- getTriple conf
  let task =
        emptyTask
          { Task.ulid = T.toLower $ show ulid
          , Task.body = ""
          , Task.state = Just Done
          , Task.due_utc = Nothing
          , Task.closed_utc = Just modified_utc
          , Task.user = T.pack effectiveUserName
          , Task.modified_utc = modified_utc
          }

  insertRecord "tasks" conn task
  pure task


-- TODO: Eliminate code duplications with `editTask`
addTask :: Config -> Connection -> [Text] -> IO (Doc AnsiStyle)
addTask conf connection bodyWords = do
  (ulid, modified_utc, effectiveUserName) <- getTriple conf
  let
    (body, tags, dueUtcMb, createdUtcMb) = parseTaskBody bodyWords
    importTaskDraft =
      ImportTask
        { task =
            emptyTask
              { Task.ulid = T.toLower $ show $ case createdUtcMb of
                  Nothing -> ulid
                  Just createdUtc -> setDateTime ulid createdUtc
              , Task.body = body
              , Task.due_utc = dueUtcMb
              , Task.modified_utc = modified_utc
              , Task.user = T.pack effectiveUserName
              }
        , tags = tags
        , notes = [] -- TODO: Add notes to task
        }

  args <- getArgs
  preAddResults <-
    executeHooks
      ( TL.toStrict $
          TL.decodeUtf8 $
            Aeson.encode $
              object
                [ "arguments" .= args
                , "taskToAdd" .= importTaskToFullTask importTaskDraft
                ]
      )
      conf.hooks.add.pre

  -- Maybe the task was changed by the hook
  (importTask, preAddHookMsg) <- case preAddResults of
    [] -> pure (importTaskDraft, Empty)
    [Left error] -> do
      _ <- exitFailure
      pure (importTaskDraft, pretty error)
    [Right hookResult] -> do
      case hookResult.task of
        Nothing -> pure (importTaskDraft, Empty)
        Just task -> do
          fullImportTask <- setMissingFields task
          pure (fullImportTask, formatHookResult conf hookResult)
    _ -> do
      pure
        ( importTaskDraft
        , annotate (colr conf Red) $
            "ERROR: Multiple pre-add hooks are not supported yet. "
              <> "None of the hooks were executed."
        )

  insertRecord "tasks" connection importTask.task
  warnings <- insertTags conf connection Nothing importTask.task importTask.tags

  -- TODO: Use RETURNING clause in `insertRecord` instead
  (insertedTasks :: [FullTask]) <-
    queryNamed
      connection
      "SELECT * FROM tasks_view WHERE ulid == :ulid"
      [":ulid" := importTask.task.ulid]

  case insertedTasks of
    [insertedTask] -> do
      postAddResults <-
        executeHooks
          ( TL.toStrict $
              TL.decodeUtf8 $
                Aeson.encode $
                  object
                    [ "arguments" .= args
                    , "taskAdded" .= insertedTask
                    -- TODO: Add tags and notes to task
                    ]
          )
          conf.hooks.add.post

      let
        postAddHookMsg :: Doc AnsiStyle
        postAddHookMsg =
          ( postAddResults
              <&> \case
                Left error -> "ERROR:" <+> pretty error
                Right hookResult -> pretty hookResult.message
              & P.fold
          )
            <> hardline

      pure $
        [ preAddHookMsg
        , warnings
        , "🆕 Added task"
            <+> dquotes (pretty importTask.task.body)
            <+> "with id"
            <+> dquotes (pretty importTask.task.ulid)
        , postAddHookMsg
        ]
          & P.filter (\d -> show d /= T.empty)
          & vsep
    ---
    _ -> pure "Task could not be added"


logTask :: Config -> Connection -> [Text] -> IO (Doc AnsiStyle)
logTask conf connection bodyWords = do
  (ulid, modified_utc, effectiveUserName) <- getTriple conf
  let
    (body, extractedTags, dueUtcMb, createdUtcMb) = parseTaskBody bodyWords
    tags = extractedTags <> ["log"]
    task =
      emptyTask
        { Task.ulid = T.toLower $ show $ case createdUtcMb of
            Nothing -> ulid
            Just createdUtc -> setDateTime ulid createdUtc
        , Task.body = body
        , Task.state = Just Done
        , Task.due_utc = dueUtcMb
        , Task.closed_utc = Just modified_utc
        , Task.user = T.pack effectiveUserName
        , Task.modified_utc = modified_utc
        }

  insertRecord "tasks" connection task
  warnings <- insertTags conf connection Nothing task tags
  pure $
    warnings
      <$$> "📝 Logged task"
      <+> dquotes (pretty task.body)
      <+> "with id"
      <+> dquotes (pretty task.ulid)


execWithTask ::
  Config ->
  Connection ->
  Text ->
  (Task -> IO (Doc AnsiStyle)) ->
  IO (Doc AnsiStyle)
execWithTask conf connection idSubstr callback = do
  tasks <-
    query
      connection
      ( Query $
          "SELECT *\n"
            <> ("FROM \"" <> conf.tableName <> "\"\n")
            <> "WHERE ulid LIKE ?\n"
      )
      ["%" <> idSubstr :: Text] ::
      IO [Task]

  let
    numOfTasks = P.length tasks
    ulidLength = 26
    prefix = if T.length idSubstr == ulidLength then "" else "…"
    quote = dquotes . pretty

  if
    | numOfTasks == 0 ->
        pure $
          "⚠️  Task" <+> quote (prefix <> idSubstr) <+> "does not exist"
    | numOfTasks == 1 ->
        callback $ fromMaybe emptyTask $ P.head tasks
    | numOfTasks > 1 ->
        pure $
          "⚠️  Id slice"
            <+> quote idSubstr
            <+> "is not unique."
            <+> "It could refer to one of the following tasks:"
              <++> P.foldMap
                ( \task ->
                    annotate conf.idStyle (pretty task.ulid)
                      <++> pretty task.body
                      <> hardline
                )
                tasks
    | otherwise -> pure "This case should not be possible"


-- | Set state and automatically sets `closed_utc` via an SQL trigger
setClosedWithState :: Connection -> Task -> Maybe TaskState -> IO ()
setClosedWithState connection task theTaskState = do
  executeNamed
    connection
    [sql|
      UPDATE tasks
      SET
        state = :state,
        review_utc = NULL
      WHERE
        ulid == :ulid AND
        (state IS NULL OR state != :state)
    |]
    [ ":ulid" := task.ulid
    , ":state" := theTaskState
    ]


setReadyUtc ::
  Config -> Connection -> DateTime -> [IdText] -> IO (Doc AnsiStyle)
setReadyUtc conf connection datetime ids = do
  let utcText = T.pack $ timePrint conf.utcFormat datetime

  docs <- forM ids $ \idSubstr ->
    execWithTask conf connection idSubstr $ \task -> do
      updateTask connection $ task{Task.ready_utc = Just utcText}

      let
        prettyBody = dquotes $ pretty task.body
        prettyId = dquotes $ pretty task.ulid

      pure $
        "📅 Set ready UTC of task"
          <+> prettyBody
          <+> "with id"
          <+> prettyId
          <+> "to"
          <+> dquotes (pretty utcText)

  pure $ vsep docs


waitFor ::
  Config -> Connection -> Iso.Duration -> [Text] -> IO (Doc AnsiStyle)
waitFor conf connection duration ids = do
  docs <- forM ids $ \idSubstr ->
    execWithTask conf connection idSubstr $ \task -> do
      now <- timeCurrentP
      let
        nowAsText = (T.pack . timePrint conf.utcFormat) now
        threeDays =
          (T.pack . timePrint conf.utcFormat)
            ( utcTimeToDateTime $
                Iso.addDuration duration $
                  dateTimeToUtcTime $
                    timeFromElapsedP now
            )

      executeNamed
        connection
        [sql|
          UPDATE tasks
          SET
            waiting_utc = :waiting_utc,
            review_utc = :review_utc
          WHERE
            ulid == :ulid
        |]
        [ ":ulid" := task.ulid
        , ":waiting_utc" := nowAsText
        , ":review_utc" := threeDays
        ]

      let
        prettyBody = dquotes $ pretty task.body
        prettyId = dquotes $ pretty task.ulid

      numOfChanges <- changes connection

      pure $
        if numOfChanges == 0
          then
            "⚠️  An error occurred while moving task"
              <+> prettyBody
                <> "with id"
              <+> prettyId
              <+> "into waiting mode"
          else
            "⏳  Set waiting UTC and review UTC for task"
              <+> prettyBody
              <+> "with id"
              <+> prettyId

  pure $ vsep docs


waitTasks :: Config -> Connection -> [Text] -> IO (Doc AnsiStyle)
waitTasks conf connection =
  waitFor conf connection $
    Iso.DurationDate (Iso.DurDateDay (Iso.DurDay 3) Nothing)


reviewTasksIn ::
  Config ->
  Connection ->
  Iso.Duration ->
  [Text] ->
  IO (Doc AnsiStyle)
reviewTasksIn conf connection duration ids = do
  docs <- forM ids $ \idSubstr -> do
    execWithTask conf connection idSubstr $ \task -> do
      now <- timeCurrentP
      let
        xDays =
          (T.pack . timePrint conf.utcFormat)
            ( utcTimeToDateTime $
                Iso.addDuration duration $
                  dateTimeToUtcTime $
                    timeFromElapsedP now
            )
        prettyBody = dquotes $ pretty task.body
        prettyId = dquotes $ pretty task.ulid
        warningStart = "⚠️  Task" <+> prettyBody <+> "with id" <+> prettyId

      if isJust task.closed_utc
        then pure $ warningStart <+> "is already closed"
        else do
          executeNamed
            connection
            [sql|
              UPDATE tasks
              SET review_utc = :review_utc
              WHERE ulid == :ulid
            |]
            [ ":ulid" := task.ulid
            , ":review_utc" := xDays
            ]

          numOfChanges <- changes connection

          pure $
            if numOfChanges == 0
              then warningStart <+> "could not be reviewed"
              else getResultMsg task "🔎 Finished review"

  pure $ vsep docs


showDateTime :: Config -> DateTime -> Text
showDateTime conf =
  T.pack . timePrint conf.utcFormat


showEither :: Config -> Either a UTCTime -> Maybe Text
showEither conf theEither =
  theEither
    & either (const Nothing) Just
    <&> (utcTimeToDateTime >>> showDateTime conf)


-- TODO: Eliminate code duplication with createNextRecurrence
createNextRepetition ::
  Config -> Connection -> Task -> IO (Maybe (Doc AnsiStyle))
createNextRepetition conf connection task = do
  newUlidText <- formatUlid getULID
  let
    nowMb =
      ulidTextToDateTime newUlidText

    durTextEither =
      maybeToEither
        "Task has no repetition duration"
        task.repetition_duration

    isoDurEither =
      durTextEither
        <&> encodeUtf8
          >>= Iso.parseDuration

    nextDueMb =
      liftA2
        Iso.addDuration
        isoDurEither
        ( maybeToEither
            "ULID can't be converted to UTC time"
            (nowMb <&> dateTimeToUtcTime)
        )

    newTask =
      task
        { Task.ulid = newUlidText
        , Task.due_utc = nextDueMb & showEither conf
        , Task.closed_utc = Nothing
        , Task.state = Nothing
        , Task.awake_utc =
            liftA2
              Iso.addDuration
              isoDurEither
              ( maybeToEither
                  "Task has no awake UTC"
                  (task.awake_utc >>= parseUtc <&> dateTimeToUtcTime)
              )
              & showEither conf
        , Task.ready_utc =
            liftA2
              Iso.addDuration
              isoDurEither
              ( maybeToEither
                  "Task has no ready UTC"
                  (task.ready_utc >>= parseUtc <&> dateTimeToUtcTime)
              )
              & showEither conf
        , Task.modified_utc =
            nowMb
              <&> (timePrint conf.utcFormat >>> T.pack)
              & fromMaybe ""
        , Task.review_utc = Nothing
        }

  insertRecord "tasks" connection newTask

  tags <-
    query
      connection
      [sql|
        SELECT tag
        FROM task_to_tag
        WHERE task_ulid == ?
      |]
      (Only task.ulid)

  warnings <-
    liftIO $ insertTags conf connection Nothing newTask (tags & P.concat)

  liftIO $
    pure $
      Just $
        warnings
          <$$> "➡️ Created next task"
          <+> dquotes (pretty newTask.body)
          <+> "in repetition series"
          <+> dquotes (pretty newTask.group_ulid)
          <+> "with id"
          <+> dquotes (pretty newUlidText)


-- TODO: Eliminate code duplication with createNextRepetition
createNextRecurrence ::
  Config -> Connection -> Task -> IO (Maybe (Doc AnsiStyle))
createNextRecurrence conf connection task = do
  newUlidText <- formatUlid getULID
  let
    dueUtcMb =
      task.due_utc >>= parseUtc

    durTextEither =
      maybeToEither
        "Task has no recurrence duration"
        task.recurrence_duration

    isoDurEither =
      durTextEither
        <&> encodeUtf8
          >>= Iso.parseDuration

    -- If task has no due UTC, use current UTC as the base for recurrence
    nowMb = ulidTextToDateTime newUlidText
    baseDateMb = dueUtcMb <|> nowMb

    nextDueMb =
      liftA2
        Iso.addDuration
        isoDurEither
        ( maybeToEither
            "Task has no due UTC current time couldn't be determined"
            (baseDateMb <&> dateTimeToUtcTime)
        )

    newTask =
      task
        { Task.ulid = newUlidText
        , Task.due_utc = nextDueMb & showEither conf
        , Task.closed_utc = Nothing
        , Task.state = Nothing
        , Task.awake_utc =
            liftA2
              Iso.addDuration
              isoDurEither
              ( maybeToEither
                  "Task has no awake UTC"
                  (task.awake_utc >>= parseUtc <&> dateTimeToUtcTime)
              )
              & showEither conf
        , Task.ready_utc =
            liftA2
              Iso.addDuration
              isoDurEither
              ( maybeToEither
                  "Task has no ready UTC"
                  (task.ready_utc >>= parseUtc <&> dateTimeToUtcTime)
              )
              & showEither conf
        , Task.modified_utc =
            newUlidText
              & ulidTextToDateTime
              <&> (timePrint conf.utcFormat >>> T.pack)
              & fromMaybe ""
        , Task.review_utc = Nothing
        }

  insertRecord "tasks" connection newTask

  tags <-
    query
      connection
      [sql|
        SELECT tag
        FROM task_to_tag
        WHERE task_ulid == ?
      |]
      (Only task.ulid)

  warnings <-
    liftIO $ insertTags conf connection Nothing newTask (tags & P.concat)

  liftIO $
    pure $
      Just $
        warnings
          <$$> "➡️ Created next task"
          <+> dquotes (pretty task.body)
          <+> "in recurrence series"
          <+> dquotes (pretty task.group_ulid)
          <+> "with id"
          <+> dquotes (pretty newUlidText)


doTasks :: Config -> Connection -> Maybe [Text] -> [Text] -> IO (Doc AnsiStyle)
doTasks conf connection noteWordsMaybe ids = do
  docs <- forM ids $ \idSubstr -> do
    execWithTask conf connection idSubstr $ \task -> do
      let
        prettyBody = dquotes $ pretty task.body
        prettyId = dquotes $ pretty task.ulid

      if isJust task.closed_utc
        then
          pure $
            "⚠️  Task"
              <+> prettyBody
              <+> "with id"
              <+> prettyId
              <+> "is already done"
        else do
          logMessageMaybe <-
            if isJust task.repetition_duration
              then createNextRepetition conf connection task
              else
                if isJust task.recurrence_duration
                  then createNextRecurrence conf connection task
                  else pure Nothing

          noteMessageMaybe <- case noteWordsMaybe of
            Nothing -> pure Nothing
            Just noteWords ->
              liftIO $
                addNote conf connection (unwords noteWords) ids <&> Just

          setClosedWithState connection task $ Just Done

          pure $
            fromMaybe "" (noteMessageMaybe <&> (<> hardline))
              <> ( "✅ Finished task"
                    <+> dquotes (pretty task.body)
                    <+> "with id"
                    <+> dquotes (pretty task.ulid)
                 )
              <> fromMaybe "" (logMessageMaybe <&> (hardline <>))

  pure $ vsep docs


endTasks :: Config -> Connection -> Maybe [Text] -> [Text] -> IO (Doc AnsiStyle)
endTasks conf connection noteWordsMaybe ids = do
  docs <- forM ids $ \idSubstr -> do
    execWithTask conf connection idSubstr $ \task -> do
      let
        prettyBody = dquotes $ pretty task.body
        prettyId = dquotes $ pretty task.ulid

      if isJust task.closed_utc
        then
          pure $
            "⚠️  Task"
              <+> prettyBody
              <+> "with id"
              <+> prettyId
              <+> "is already marked as obsolete"
        else do
          logMessageMaybe <-
            if isJust task.repetition_duration
              then createNextRepetition conf connection task
              else
                if isJust task.recurrence_duration
                  then createNextRecurrence conf connection task
                  else pure Nothing

          noteMessageMaybe <- case noteWordsMaybe of
            Nothing -> pure Nothing
            Just noteWords ->
              liftIO $
                addNote conf connection (unwords noteWords) ids <&> Just

          setClosedWithState connection task $ Just Obsolete

          pure $
            fromMaybe "" (noteMessageMaybe <&> (<> hardline))
              <> ( "⏹  Marked task"
                    <+> prettyBody
                    <+> "with id"
                    <+> prettyId
                    <+> "as obsolete"
                 )
              <> fromMaybe "" (logMessageMaybe <&> (hardline <>))

  pure $ vsep docs


trashTasks :: Config -> Connection -> [Text] -> IO (Doc AnsiStyle)
trashTasks conf connection ids = do
  docs <- forM ids $ \idSubstr -> do
    execWithTask conf connection idSubstr $ \task -> do
      setClosedWithState connection task $ Just Deletable
      numOfChanges <- changes connection

      let
        prettyBody = dquotes $ pretty task.body
        prettyId = dquotes $ pretty task.ulid

      pure $
        if numOfChanges == 0
          then
            "⚠️  Task"
              <+> prettyBody
              <+> "with id"
              <+> prettyId
              <+> "is already marked as deletable"
          else
            "🗑  Marked task"
              <+> prettyBody
              <+> "with id"
              <+> prettyId
              <+> "as deletable"

  pure $ vsep docs


deleteTasks :: Config -> Connection -> [Text] -> IO (Doc AnsiStyle)
deleteTasks conf connection ids = do
  docs <- forM ids $ \idSubstr -> do
    execWithTask conf connection idSubstr $ \task -> do
      execute
        connection
        [sql|
          DELETE FROM tasks
          WHERE ulid == ?
        |]
        (Only task.ulid)

      execute
        connection
        [sql|
          DELETE FROM task_to_tag
          WHERE task_ulid == ?
        |]
        (Only task.ulid)

      execute
        connection
        [sql|
          DELETE FROM task_to_note
          WHERE task_ulid == ?
        |]
        (Only task.ulid)

      let
        prettyBody = dquotes $ pretty task.body
        prettyId = dquotes $ pretty task.ulid

      pure $ "❌ Deleted task" <+> prettyBody <+> "with id" <+> prettyId

  pure $ vsep docs


durationToIso :: Duration -> Text
durationToIso dur =
  "PT" <> show (coerce (durationMinutes dur) :: Int64) <> "M"


repeatTasks ::
  Config -> Connection -> Iso.Duration -> [IdText] -> IO (Doc AnsiStyle)
repeatTasks conf connection duration ids = do
  let durationIsoText = decodeUtf8 $ Iso.formatDuration duration

  docs <- forM ids $ \idSubstr ->
    execWithTask conf connection idSubstr $ \task -> do
      groupUlid <- formatUlid getULID

      recDur :: [Only SQLData] <-
        queryNamed
          connection
          [sql|
            UPDATE tasks
            SET
              repetition_duration = :repetition_duration,
              group_ulid = :group_ulid
            WHERE
              ulid == :ulid AND
              recurrence_duration IS NULL
            RETURNING recurrence_duration
          |]
          [ ":repetition_duration" := durationIsoText
          , ":group_ulid" := groupUlid
          , ":ulid" := task.ulid
          ]

      if recDur /= [Only SQLNull]
        then
          pure $
            "⚠️ Task"
              <+> dquotes (pretty task.body)
              <+> "with id"
              <+> dquotes (pretty task.ulid)
              <+> "is already in a recurrence series"
        else do
          -- If repetition is set for already closed task,
          -- next task in series must be created immediately
          creationMb <-
            if isNothing task.closed_utc
              then pure $ Just mempty
              else
                liftIO $
                  createNextRepetition conf connection $
                    task
                      { Task.repetition_duration = Just durationIsoText
                      , Task.group_ulid = Just groupUlid
                      }

          pure $
            "📅 Set repeat duration of task"
              <+> dquotes (pretty task.body)
              <+> "with id"
              <+> dquotes (pretty task.ulid)
              <+> "to"
              <+> dquotes (pretty durationIsoText)
                <++> ( creationMb
                        & fromMaybe
                          "⚠️ Next task in repetition series could not be created!"
                     )

  pure $ vsep docs


recurTasks ::
  Config -> Connection -> Iso.Duration -> [IdText] -> IO (Doc AnsiStyle)
recurTasks conf connection duration ids = do
  let durationIsoText = decodeUtf8 $ Iso.formatDuration duration

  docs <- forM ids $ \idSubstr ->
    execWithTask conf connection idSubstr $ \task -> do
      groupUlid <- formatUlid getULID

      repDur :: [Only SQLData] <-
        queryNamed
          connection
          [sql|
            UPDATE tasks
            SET
              recurrence_duration = :recurrence_duration,
              group_ulid = :group_ulid
            WHERE
              ulid == :ulid AND
              repetition_duration IS NULL
            RETURNING repetition_duration
          |]
          [ ":recurrence_duration" := durationIsoText
          , ":group_ulid" := groupUlid
          , ":ulid" := task.ulid
          ]

      if repDur /= [Only SQLNull]
        then
          pure $
            "⚠️ Task"
              <+> dquotes (pretty task.body)
              <+> "with id"
              <+> dquotes (pretty task.ulid)
              <+> "is already in a repetition series"
        else do
          -- If recurrence is set for already closed task,
          -- next task in series must be created immediately
          creationMb <-
            if isNothing task.closed_utc
              then pure $ Just mempty
              else
                liftIO $
                  createNextRecurrence conf connection $
                    task
                      { Task.recurrence_duration = Just durationIsoText
                      , Task.group_ulid = Just groupUlid
                      }

          pure $
            "📅 Set recurrence duration of task"
              <+> dquotes (pretty task.body)
              <+> "with id"
              <+> dquotes (pretty task.ulid)
              <+> "to"
              <+> dquotes (pretty durationIsoText)
                <++> ( creationMb
                        & fromMaybe
                          "⚠️ Next task in recurrence series could not be created!"
                     )

  pure $ vsep docs


adjustPriority :: Config -> Float -> [IdText] -> IO (Doc AnsiStyle)
adjustPriority conf adjustment ids = do
  dbPath <- getDbPath conf
  withConnection dbPath $ \connection -> do
    docs <- forM ids $ \idSubstr -> do
      execWithTask conf connection idSubstr $ \task -> do
        executeNamed
          connection
          [sql|
            UPDATE tasks
            SET priority_adjustment =
              ifnull(priority_adjustment, 0) + :adjustment
            WHERE ulid == :ulid
          |]
          [ ":adjustment" := adjustment
          , ":ulid" := task.ulid
          ]

        numOfChanges <- changes connection

        let prettyBody = dquotes $ pretty task.body

        pure $
          if numOfChanges == 0
            then
              "⚠️ An error occurred while adjusting the priority of task"
                <+> prettyBody
            else
              (if adjustment > 0 then "⬆️  Increased" else "⬇️  Decreased")
                <+> "priority of task"
                <+> prettyBody
                <+> "with id"
                <+> dquotes (pretty task.ulid)
                <+> "by"
                <+> pretty (abs adjustment)

    pure $ vsep docs


startTasks :: Config -> Connection -> [Text] -> IO (Doc AnsiStyle)
startTasks conf connection ids = do
  logMessage <- addNote conf connection "start" ids

  pure $
    pretty $
      T.replace
        "📝  Added a note to"
        "⏳ Started"
        (show logMessage)


stopTasks :: Config -> Connection -> [Text] -> IO (Doc AnsiStyle)
stopTasks conf connection ids = do
  logMessages <- addNote conf connection "stop" ids

  pure $
    pretty $
      T.replace
        "📝  Added a note to"
        "⌛️ Stopped"
        (show logMessages)


formatTaskForInfo ::
  Config ->
  DateTime ->
  (FullTask, [TaskToTag], [TaskToNote]) ->
  Doc AnsiStyle
formatTaskForInfo conf now (taskV, tags, notes) =
  let
    mkGreen = annotate (colr conf Green)
    grayOut = annotate (colrDull conf Black)
    stateHierarchy = getStateHierarchy now $ cpTimesAndState taskV
    mbCreatedUtc =
      fmap
        (T.pack . timePrint (utcFormat defaultConfig))
        (ulidTextToDateTime taskV.ulid)
    tagsPretty =
      tags
        <&> ( \t ->
                annotate conf.tagStyle (pretty t.tag)
                  <++> maybe
                    mempty
                    (grayOut . pretty . T.pack . timePrint conf.utcFormat)
                    (ulidTextToDateTime t.ulid)
                  <++> grayOut (pretty t.ulid)
            )
    notesPretty =
      notes
        <&> ( \n ->
                maybe
                  mempty
                  (grayOut . pretty . T.pack . timePrint conf.utcFormat)
                  (ulidTextToDateTime n.ulid)
                  <++> grayOut (pretty n.ulid)
                  <> hardline
                  <> indent 2 (pretty n.note)
                  <> hardline
            )

    mbAwakeUtc = FullTask.awake_utc taskV
    mbReadyUtc = FullTask.ready_utc taskV
    mbWaitingUtc = FullTask.waiting_utc taskV
    mbReviewUtc = FullTask.review_utc taskV
    mbDueUtc = FullTask.due_utc taskV
    mbClosedUtc = FullTask.closed_utc taskV
    mbModifiedUtc = Just $ FullTask.modified_utc taskV

    printIf :: Doc AnsiStyle -> Maybe Text -> Maybe (Doc AnsiStyle)
    printIf name =
      fmap
        ( \v ->
            name
              <+> annotate conf.dueStyle (pretty v)
                <> hardline
        )
  in
    hardline
      <> annotate bold (pretty taskV.body)
      <> hardline
      <> hardline
      <> ( if P.null tags
            then mempty
            else
              (tags <&> (TaskToTag.tag >>> formatTag conf) & hsep)
                <> hardline
                <> hardline
         )
      <> ( if P.null notes
            then mempty
            else
              ( notes
                  <&> ( \n ->
                          maybe
                            mempty
                            ( grayOut
                                . pretty
                                . T.pack
                                . timePrint
                                  conf.utcFormatShort
                            )
                            (ulidTextToDateTime n.ulid)
                            <++> align (pretty n.note)
                      )
                  & vsep
              )
                <> hardline
                <> hardline
         )
      <> ( "   State:"
            <+> mkGreen (pretty stateHierarchy)
              <> hardline
         )
      <> ( "Priority:"
            <+> annotate
              conf.priorityStyle
              (pretty $ FullTask.priority taskV)
              <> hardline
         )
      <> ( "    ULID:"
            <+> grayOut (pretty $ FullTask.ulid taskV)
              <> hardline
         )
      <> hardline
      <> ( [ (printIf "🆕  Created  ", mbCreatedUtc)
           , (printIf "☀️   Awake   ", mbAwakeUtc)
           , (printIf "📅   Ready   ", mbReadyUtc)
           , (printIf "⏳  Waiting  ", mbWaitingUtc)
           , (printIf "🔎  Review   ", mbReviewUtc)
           , (printIf "📅    Due    ", mbDueUtc)
           , (printIf "✅   Done    ", mbClosedUtc)
           , (printIf "✏️   Modified ", mbModifiedUtc)
           ]
            & sortBy (compare `on` snd)
            & P.mapMaybe (\tup -> fst tup (snd tup))
            & punctuate (pretty ("       ⬇" :: Text))
            & vsep
         )
      <> hardline
      <> maybe
        mempty
        ( \value ->
            "Repetition Duration:"
              <+> mkGreen (pretty value)
                <> hardline
        )
        (FullTask.repetition_duration taskV)
      <> maybe
        mempty
        ( \value ->
            "Recurrence Duration:"
              <+> mkGreen (pretty value)
                <> hardline
        )
        (FullTask.recurrence_duration taskV)
      <> maybe
        mempty
        ( \value ->
            "Group Ulid:"
              <+> grayOut (pretty value)
                <> hardline
        )
        (FullTask.group_ulid taskV)
      <> ( "User:"
            <+> mkGreen (pretty $ FullTask.user taskV)
              <> hardline
         )
      <> hardline
      <> maybe
        mempty
        ( \value ->
            "Metadata:"
              <> hardline
              <> indent 2 (pretty $ decodeUtf8 $ Yaml.encode value)
              <> hardline
        )
        (FullTask.metadata taskV)
      <> ( if P.null tags
            then mempty
            else
              annotate underlined "Tags Detailed:"
                <> hardline
                <> hardline
                <> vsep tagsPretty
                <> hardline
                <> hardline
         )
      <> ( if P.null notes
            then mempty
            else
              annotate underlined "Notes Detailed:"
                <> hardline
                <> hardline
                <> vsep notesPretty
                <> hardline
         )


infoTask :: Config -> Connection -> Text -> IO (Doc AnsiStyle)
infoTask conf connection idSubstr = do
  execWithTask conf connection idSubstr $ \task -> do
    now <- dateCurrent

    fullTasks :: [FullTask] <-
      query
        connection
        [sql|
          SELECT *
          FROM tasks_view
          WHERE ulid == ?
        |]
        (Only task.ulid)

    tags <-
      query
        connection
        [sql|
          SELECT *
          FROM task_to_tag
          WHERE task_ulid == ?
        |]
        (Only task.ulid)

    notes <-
      query
        connection
        [sql|
          SELECT *
          FROM task_to_note
          WHERE task_ulid == ?
        |]
        (Only task.ulid)

    pure $ case fullTasks of
      [fullTask] -> formatTaskForInfo conf now (fullTask, tags, notes)
      _ -> pretty noTasksWarning


nextTask :: Config -> Connection -> IO (Doc AnsiStyle)
nextTask conf connection = do
  now <- dateCurrent

  tasks :: [FullTask] <-
    query_
      connection
      [sql|
        SELECT *
        FROM tasks_view
        WHERE closed_utc IS NULL
        ORDER BY priority DESC
        LIMIT 1
      |]

  case tasks of
    [fullTask] -> do
      tags <-
        query
          connection
          [sql|
            SELECT *
            FROM task_to_tag
            WHERE task_ulid == ?
          |]
          (Only fullTask.ulid)

      notes <-
        query
          connection
          [sql|
            SELECT *
            FROM task_to_note
            WHERE task_ulid == ?
          |]
          (Only fullTask.ulid)

      pure $ formatTaskForInfo conf now (fullTask, tags, notes)
    _ ->
      pure $ pretty noTasksWarning


randomTask ::
  Config -> Connection -> Maybe [Text] -> IO (Doc AnsiStyle)
randomTask conf connection filterExpression = do
  let
    parserResults =
      readP_to_S filterExpsParser $
        T.unpack (unwords $ fromMaybe [""] filterExpression)
    filterMay = listToMaybe parserResults

  case filterMay of
    Nothing -> do
      (tasks :: [FullTask]) <-
        query_
          connection
          [sql|
            SELECT *
            FROM tasks_view
            WHERE closed_utc IS NULL
            ORDER BY random()
            LIMIT 1
          |]

      case tasks of
        [fullTask] -> infoTask conf connection fullTask.ulid
        _ -> pure $ pretty noTasksWarning
    --
    Just (filterExps, _) -> do
      let
        ppInvalidFilter = \case
          (InvalidFilter error) ->
            dquotes (pretty error) <+> "is an invalid filter"
          (HasStatus Nothing) -> "Filter contains an invalid state value"
          _ -> "The functions should not be called with a valid function"
        errors = P.filter (not . isValidFilter) filterExps
        errorsDoc =
          if P.length errors > 0
            then
              Just $
                vsep (fmap (annotate (colr conf Red) . ppInvalidFilter) errors)
                  <> hardline
                  <> hardline
            else Nothing

      tasks <-
        query_ connection $
          getFilterQuery
            (HasStatus (Just IsOpen) : filterExps)
            (Just "random()")
            Nothing

      case P.headMay (tasks :: [FullTask]) of
        Nothing -> pure $ pretty noTasksWarning
        Just fullTask -> do
          taskFormatted <- infoTask conf connection fullTask.ulid
          pure $ errorsDoc & fromMaybe taskFormatted


findTask :: Config -> Connection -> Text -> IO (Doc AnsiStyle)
findTask conf connection aPattern = do
  tasks :: [(Text, Text, Maybe [Text], Maybe [Text], Maybe Text)] <-
    query_
      connection
      [sql|
        SELECT ulid, body, tags, notes, metadata
        FROM tasks_view
      |]

  let
    ulidWidth = 5
    numOfResults = 8
    minimumScore = 5
    ulidColor = Green
    -- TODO: Escape sequences are counted as several chars and mess up wrapping.
    --       Implement first: https://github.com/ad-si/Fuzzily/issues/1
    preTag = "\x1b[4m\x1b[34m" -- Set color to blue and underline text
    postTag = "\x1b[0m" -- Reset styling
    metaNorm metadata =
      metadata
        & fromMaybe ""
        & T.replace ",\"" ", \""
        & T.replace "\":" "\": "
        & T.replace "\"" ""
    matchFunc =
      Fuzzily.match
        Fuzzily.IgnoreCase
        (preTag, postTag)
        identity
        aPattern

    -- Calculate fuzzy score for each part individually
    -- and pick the highest one
    scoreFunc (ulid, theBody, _, mbNotes, mbMetadata) =
      let
        scoreParts =
          [ ( matchFunc theBody
                -- Weight the body score higher
                <&> \case
                  Fuzzily.Fuzzy{score, ..} ->
                    Fuzzily.Fuzzy{score = score + 1, ..}
            )
              -- Always include the body
              <|> ( Just $
                      Fuzzily.Fuzzy
                        { original = theBody
                        , rendered = theBody
                        , score = 0
                        }
                  )
          , matchFunc (maybe "" unwords mbNotes)
          , -- TODO: Find good way to include tags
            -- , matchFunc (maybe "" unwords mbTags)
            matchFunc (metaNorm mbMetadata)
          , matchFunc ulid
          ]
        highestScore = P.maximum $ 0 : (catMaybes scoreParts <&> Fuzzily.score)
        combinedText =
          scoreParts
            & catMaybes
            <&> (Fuzzily.rendered >>> reflow)
            & P.intersperse mempty
            & vcat
      in
        (highestScore, ulid, combinedText)

    fstOf3 (x, _, _) = x
    tasksScored =
      tasks
        <&> scoreFunc
        & P.filter ((> minimumScore) . fstOf3)
        & sortOn (Down . fstOf3)
    moreResults = P.length tasksScored - numOfResults
    header =
      annotate (underlined <> color ulidColor) (fill ulidWidth "ULID")
        <++> annotate underlined (fill 20 "Task")
        <> hardline
    body =
      tasksScored
        & P.take numOfResults
        <&> ( \(_, ulid, combinedText) ->
                annotate
                  (colr conf ulidColor)
                  (fill ulidWidth $ pretty $ T.takeEnd ulidWidth ulid)
                  <> indent 2 combinedText
            )
        & P.intersperse mempty
        & vsep
    footer =
      if moreResults > 0
        then
          hardline
            <> hardline
            <> annotate
              (colr conf Red)
              ("There are " <> pretty moreResults <> " more results available")
            <> hardline
        else hardline

  pure $ header <> body <> footer


-- TODO: Use Continuation monad to avoid callback hell
-- withConnectCont :: Text -> ContT a IO Connection
-- withConnectCont dbPath =
--     ContT $ withConnection dbPath

addTag :: Config -> Connection -> Text -> [IdText] -> IO (Doc AnsiStyle)
addTag conf conn tag ids = do
  let tagNorm = T.dropWhile (== '+') tag
  docs <- forM ids $ \idSubstr ->
    execWithTask conf conn idSubstr $ \task -> do
      now <- fmap (T.pack . timePrint conf.utcFormat) timeCurrentP
      ulid <- formatUlid getULID

      catchIf
        -- TODO: Find out why it's not `ErrorConstraintUnique`
        (\(err :: SQLError) -> err.sqlError == ErrorConstraint)
        ( do
            insertRecord
              "task_to_tag"
              conn
              TaskToTag{ulid, task_ulid = task.ulid, tag = tagNorm}

            -- TODO: Check if modified_utc could be set via SQL trigger
            executeNamed
              conn
              [sql|
                UPDATE tasks
                SET modified_utc = :now
                WHERE ulid == :ulid
              |]
              [ ":now" := now
              , ":ulid" := task.ulid
              ]

            let
              prettyBody = dquotes $ pretty task.body
              prettyId = dquotes $ pretty task.ulid

            pure $
              "🏷  Added tag"
                <+> dquotes (pretty tagNorm)
                <+> "to task"
                <+> prettyBody
                <+> "with id"
                <+> prettyId
        )
        (handleTagDupError conf tagNorm)

  pure $ vsep docs


deleteTag :: Config -> Connection -> Text -> [IdText] -> IO (Doc AnsiStyle)
deleteTag conf connection tag ids = do
  docs <- forM ids $ \idSubstr -> do
    execWithTask conf connection idSubstr $ \task -> do
      executeNamed
        connection
        [sql|
          DELETE FROM task_to_tag
          WHERE
            task_ulid == :task_ulid
            AND tag == :tag
        |]
        [ ":task_ulid" := task.ulid
        , ":tag" := tag
        ]

      numOfChanges <- changes connection

      pure $
        if numOfChanges == 0
          then
            annotate (colr conf Yellow) $
              "⚠️  Tag"
                <+> dquotes (pretty tag)
                <+> "is not set for task"
                <+> dquotes (pretty task.ulid)
          else getResultMsg task ("💥 Removed tag \"" <> pretty tag <> "\"")

  pure $ vsep docs


addNote :: Config -> Connection -> Text -> [IdText] -> IO (Doc AnsiStyle)
addNote conf connection noteBody ids = do
  docs <- forM ids $ \idSubstr ->
    execWithTask conf connection idSubstr $ \task -> do
      now <- timeCurrentP <&> (timePrint conf.utcFormat >>> T.pack)
      ulid <- formatUlid getULID

      insertRecord
        "task_to_note"
        connection
        TaskToNote
          { ulid
          , task_ulid = task.ulid
          , TaskToNote.note = noteBody
          }

      -- TODO: Check if modified_utc could be set via SQL trigger
      executeNamed
        connection
        [sql|
          UPDATE tasks
          SET modified_utc = :now
          WHERE ulid == :ulid
        |]
        [ ":now" := now
        , ":ulid" := task.ulid
        ]

      let
        prettyBody = dquotes $ pretty task.body
        prettyId = dquotes $ pretty task.ulid

      pure $
        "🗒  Added a note to task"
          <+> prettyBody
          <+> "with id"
          <+> prettyId

  pure $ vsep docs


deleteNote :: Config -> Connection -> IdText -> IO (Doc AnsiStyle)
deleteNote conf connection noteId = do
  taskIds :: [Only Text] <-
    queryNamed
      connection
      [sql|
        DELETE FROM task_to_note
        WHERE ulid == :noteId
        RETURNING task_ulid
      |]
      [":noteId" := noteId]

  case taskIds of
    [Only taskId] ->
      pure $
        "💥 Deleted note"
          <+> dquotes (pretty noteId)
          <+> "of task"
          <+> dquotes (pretty taskId)
    [] ->
      pure $
        annotate (colr conf Yellow) $
          "⚠️  Note" <+> dquotes (pretty noteId) <+> "does not exist"
    _ ->
      pure $
        annotate (colr conf Yellow) $
          ("⚠️  Note" <+> dquotes (pretty noteId) <+> "exists multiple times.")
            <++> "This indicates a serious database inconsistency \
                 \and you should clean up the database manually \
                 \before continuing."


setDueUtc :: Config -> Connection -> DateTime -> [IdText] -> IO (Doc AnsiStyle)
setDueUtc conf connection datetime ids = do
  let
    utcText :: Text
    utcText = T.pack $ timePrint conf.utcFormat datetime

  docs <- forM ids $ \idSubstr ->
    execWithTask conf connection idSubstr $ \task -> do
      updateTask connection task{Task.due_utc = Just utcText}

      let
        prettyBody = dquotes $ pretty task.body
        prettyId = dquotes $ pretty task.ulid

      pure $
        "📅 Set due UTC of task"
          <+> prettyBody
          <+> "with id"
          <+> prettyId
          <+> "to"
          <+> dquotes (pretty utcText)

  pure $ vsep docs


getResultMsg :: Task -> Doc AnsiStyle -> Doc AnsiStyle
getResultMsg task msg = do
  let
    prettyBody = dquotes $ pretty task.body
    prettyId = dquotes $ pretty task.ulid

  msg <+> "of task" <+> prettyBody <+> "with id" <+> prettyId


getWarnMsg :: Config -> Task -> Doc AnsiStyle -> Doc AnsiStyle
getWarnMsg conf task msg = do
  let
    prettyBody = dquotes $ pretty task.body
    prettyId = dquotes $ pretty task.ulid

  annotate (colr conf Yellow) $
    "⚠️ Task" <+> prettyBody <+> "with id" <+> prettyId <+> msg


uncloseTasks :: Config -> Connection -> [IdText] -> IO (Doc AnsiStyle)
uncloseTasks conf connection ids = do
  docs <- forM ids $ \idSubstr -> do
    execWithTask conf connection idSubstr $ \task -> do
      executeNamed
        connection
        [sql|
          UPDATE tasks
          SET
            closed_utc = NULL,
            state = NULL
          WHERE
            ulid == :ulid AND
            closed_utc IS NOT NULL AND
            state IS NOT NULL
        |]
        [":ulid" := task.ulid]

      numOfChanges <- changes connection
      pure $
        if numOfChanges == 0
          then getWarnMsg conf task "is still open"
          else getResultMsg task "💥 Removed close timestamp and state field"

  pure $ vsep docs


undueTasks :: Config -> Connection -> [IdText] -> IO (Doc AnsiStyle)
undueTasks conf connection ids = do
  docs <- forM ids $ \idSubstr -> do
    execWithTask conf connection idSubstr $ \task -> do
      executeNamed
        connection
        [sql|
          UPDATE tasks
          SET due_utc = NULL
          WHERE
            ulid == :ulid AND
            due_utc IS NOT NULL
        |]
        [":ulid" := task.ulid]

      numOfChanges <- changes connection
      pure $
        if numOfChanges == 0
          then getWarnMsg conf task "does not have a due timestamp"
          else getResultMsg task "💥 Removed due timestamp"

  pure $ vsep docs


unwaitTasks :: Config -> Connection -> [IdText] -> IO (Doc AnsiStyle)
unwaitTasks conf connection ids = do
  docs <- forM ids $ \idSubstr -> do
    execWithTask conf connection idSubstr $ \task -> do
      executeNamed
        connection
        [sql|
          UPDATE tasks
          SET waiting_utc = NULL
          WHERE
            ulid == :ulid AND
            waiting_utc IS NOT NULL
        |]
        [":ulid" := task.ulid]

      numOfChanges <- changes connection
      pure $
        if numOfChanges == 0
          then getWarnMsg conf task "does not have a waiting timestamp"
          else getResultMsg task "💥 Removed waiting and review timestamps"

  pure $ vsep docs


unwakeTasks :: Config -> Connection -> [IdText] -> IO (Doc AnsiStyle)
unwakeTasks conf connection ids = do
  docs <- forM ids $ \idSubstr -> do
    execWithTask conf connection idSubstr $ \task -> do
      executeNamed
        connection
        [sql|
          UPDATE tasks
          SET awake_utc = NULL
          WHERE
            ulid == :ulid AND
            awake_utc IS NOT NULL
        |]
        [":ulid" := task.ulid]

      numOfChanges <- changes connection
      pure $
        if numOfChanges == 0
          then getWarnMsg conf task "does not have an awake timestamp"
          else getResultMsg task "💥 Removed awake timestamp"

  pure $ vsep docs


unreadyTasks :: Config -> Connection -> [IdText] -> IO (Doc AnsiStyle)
unreadyTasks conf connection ids = do
  docs <- forM ids $ \idSubstr -> do
    execWithTask conf connection idSubstr $ \task -> do
      executeNamed
        connection
        [sql|
          UPDATE tasks
          SET ready_utc = NULL
          WHERE
            ulid == :ulid AND
            ready_utc IS NOT NULL
        |]
        [":ulid" := task.ulid]

      numOfChanges <- changes connection
      pure $
        if numOfChanges == 0
          then getWarnMsg conf task "does not have a ready timestamp"
          else getResultMsg task "💥 Removed ready timestamp"

  pure $ vsep docs


unreviewTasks :: Config -> Connection -> [IdText] -> IO (Doc AnsiStyle)
unreviewTasks conf connection ids = do
  docs <- forM ids $ \idSubstr -> do
    execWithTask conf connection idSubstr $ \task -> do
      executeNamed
        connection
        [sql|
          UPDATE tasks
          SET review_utc = NULL
          WHERE
            ulid == :ulid AND
            review_utc IS NOT NULL
        |]
        [":ulid" := task.ulid]

      numOfChanges <- changes connection
      pure $
        if numOfChanges == 0
          then getWarnMsg conf task "does not have a review timestamp"
          else getResultMsg task "💥 Removed review timestamp"

  pure $ vsep docs


unrepeatTasks :: Config -> Connection -> [IdText] -> IO (Doc AnsiStyle)
unrepeatTasks conf connection ids = do
  docs <- forM ids $ \idSubstr -> do
    execWithTask conf connection idSubstr $ \task -> do
      executeNamed
        connection
        [sql|
          UPDATE tasks
          SET repetition_duration = NULL
          WHERE
            ulid == :ulid AND
            repetition_duration IS NOT NULL
        |]
        [":ulid" := task.ulid]

      numOfChanges <- changes connection
      pure $
        if numOfChanges == 0
          then getWarnMsg conf task "does not have a repetition duration"
          else getResultMsg task "💥 Removed repetition duration"

  pure $ vsep docs


unrecurTasks :: Config -> Connection -> [IdText] -> IO (Doc AnsiStyle)
unrecurTasks conf connection ids = do
  docs <- forM ids $ \idSubstr -> do
    execWithTask conf connection idSubstr $ \task -> do
      executeNamed
        connection
        [sql|
          UPDATE tasks
          SET recurrence_duration = NULL
          WHERE
            ulid == :ulid AND
            recurrence_duration IS NOT NULL
        |]
        [":ulid" := task.ulid]

      numOfChanges <- changes connection
      pure $
        if numOfChanges == 0
          then getWarnMsg conf task "does not have a recurrence duration"
          else getResultMsg task "💥 Removed recurrence duration"

  pure $ vsep docs


untagTasks :: Config -> Connection -> [IdText] -> IO (Doc AnsiStyle)
untagTasks conf connection ids = do
  docs <- forM ids $ \idSubstr -> do
    execWithTask conf connection idSubstr $ \task -> do
      executeNamed
        connection
        [sql|
          DELETE FROM task_to_tag
          WHERE task_ulid == :task_ulid
        |]
        [":task_ulid" := task.ulid]

      numOfChanges <- changes connection
      pure $
        if numOfChanges == 0
          then getWarnMsg conf task "does not have any tags"
          else getResultMsg task "💥 Removed all tags"

  pure $ vsep docs


unnoteTasks :: Config -> Connection -> [IdText] -> IO (Doc AnsiStyle)
unnoteTasks conf connection ids = do
  docs <- forM ids $ \idSubstr -> do
    execWithTask conf connection idSubstr $ \task -> do
      executeNamed
        connection
        [sql|
          DELETE FROM task_to_note
          WHERE task_ulid == :task_ulid
        |]
        [":task_ulid" := task.ulid]

      numOfChanges <- changes connection
      pure $
        if numOfChanges == 0
          then getWarnMsg conf task "does not have any notes"
          else getResultMsg task "💥 Deleted all notes"

  pure $ vsep docs


unprioTasks :: Config -> Connection -> [IdText] -> IO (Doc AnsiStyle)
unprioTasks conf connection ids = do
  docs <- forM ids $ \idSubstr -> do
    execWithTask conf connection idSubstr $ \task -> do
      executeNamed
        connection
        [sql|
          UPDATE tasks
          SET priority_adjustment = NULL
          WHERE
            ulid == :ulid AND
            priority_adjustment IS NOT NULL
        |]
        [":ulid" := task.ulid]

      numOfChanges <- changes connection
      pure $
        if numOfChanges == 0
          then getWarnMsg conf task "does not have a priority adjustment"
          else getResultMsg task "💥 Removed priority adjustment"

  pure $ vsep docs


unmetaTasks :: Config -> Connection -> [IdText] -> IO (Doc AnsiStyle)
unmetaTasks conf connection ids = do
  docs <- forM ids $ \idSubstr -> do
    execWithTask conf connection idSubstr $ \task -> do
      executeNamed
        connection
        [sql|
          UPDATE tasks
          SET metadata = NULL
          WHERE
            ulid == :ulid AND
            metadata IS NOT NULL
        |]
        [":ulid" := task.ulid]

      numOfChanges <- changes connection
      pure $
        if numOfChanges == 0
          then getWarnMsg conf task "does not have any metadata"
          else getResultMsg task "💥 Removed metadata"

  pure $ vsep docs


duplicateTasks :: Config -> Connection -> [IdText] -> IO (Doc AnsiStyle)
duplicateTasks conf connection ids = do
  docs <- forM ids $ \idSubstr -> do
    execWithTask conf connection idSubstr $ \task -> do
      dupeUlid <- formatUlid getULID
      -- TODO: Check if modified_utc can be set via an SQL trigger
      modified_utc <- formatElapsedP conf timeCurrentP
      user <- getEffectiveUserName

      let dupeTask =
            emptyTask
              { Task.ulid = dupeUlid
              , Task.body = task.body
              , Task.modified_utc = modified_utc
              , Task.priority_adjustment = task.priority_adjustment
              , Task.user = T.pack user
              , Task.metadata = task.metadata
              }

      insertRecord "tasks" connection dupeTask

      tags <-
        query
          connection
          [sql|
            SELECT tag
            FROM task_to_tag
            WHERE task_ulid == ?
          |]
          (Only task.ulid)

      warnings <-
        liftIO $ insertTags conf connection Nothing dupeTask (tags & P.concat)

      notes <-
        query
          connection
          [sql|
            SELECT *
            FROM task_to_note
            WHERE task_ulid == ?
          |]
          (Only task.ulid)

      let
        noteTuples =
          notes <&> \theNote ->
            ( ulidTextToDateTime (TaskToNote.ulid theNote)
            , TaskToNote.note theNote
            )

      liftIO $
        insertNoteTuples
          connection
          dupeTask
          noteTuples

      numOfChanges <- changes connection

      let
        prettyBody = dquotes $ pretty task.body
        prettyId = dquotes $ pretty task.ulid

      pure $
        warnings
          <$$> if numOfChanges == 0
            then
              "⚠️  Task"
                <+> prettyBody
                <+> "with id"
                <+> prettyId
                <+> "could not be duplicated"
            else
              "👯  Created a duplicate of task"
                <+> prettyBody
                <+> "(id:"
                <+> pretty task.ulid
                <+> ")"
                <+> "with id"
                <+> pretty dupeUlid

  pure $ vsep docs


showAtPrecision :: Int -> Double -> Text
showAtPrecision numOfDigits number =
  let
    tuple = T.breakOn "." (show number)
    clipDecimalPart =
      if snd tuple == ".0"
        then T.replace ".0" (T.replicate (1 + numOfDigits) " ")
        else T.take (1 + numOfDigits)
  in
    fst tuple
      <> if numOfDigits /= 0
        then (clipDecimalPart . snd) tuple
        else ""


formatTag :: (Pretty a) => Config -> a -> Doc AnsiStyle
formatTag conf =
  annotate conf.tagStyle
    . (annotate (colr conf Black) "+" <>)
    . pretty


invalidUlidMsg :: FullTask -> Doc AnsiStyle
invalidUlidMsg task =
  "Id"
    <+> dquotes (pretty task.ulid)
    <+> "is an invalid ulid and could not be converted to a datetime"


-- | Convert seconds into a short, fractional notation like 1.5y, 2.3mo, …
formatDuration :: Seconds -> T.Text
formatDuration (Seconds seconds) = do
  let
    secInHour = 3600.0
    secInDay = 24 * secInHour
    secInMonth = 30 * secInDay
    secInYear = 12 * secInMonth

    years = fromIntegral seconds / secInYear
    months = fromIntegral seconds / secInMonth
    days = fromIntegral seconds / secInDay
    hours = fromIntegral seconds / secInHour

    format :: Double -> [Char] -> T.Text
    format val suffix =
      T.pack $ printf "%.1f%-2s" val suffix

  case () of
    _
      | years > 1 -> format years "y"
      | months > 1 -> format months "mo"
      | days > 1 -> format days "d"
      | otherwise -> format hours "h"


formatTaskPriority :: Config -> FullTask -> Doc AnsiStyle
formatTaskPriority conf task = do
  let
    prio = fromMaybe 0 task.priority
    txt = T.justifyRight 4 ' ' $ showAtPrecision 1 $ realToFrac prio
  annotate conf.priorityStyle (pretty txt)


formatTaskDue :: Config -> FullTask -> Doc AnsiStyle
formatTaskDue conf task = do
  let
    dueUtcMaybe = task.due_utc >>= parseUtc <&> format
    format = T.replace " 00:00:00" "" . T.pack . timePrint conf.utcFormat
  annotate conf.dueStyle (pretty dueUtcMaybe)


formatTaskClose :: Config -> FullTask -> Doc AnsiStyle
formatTaskClose conf task = do
  let closedUtcMaybe = task.closed_utc >>= parseUtc <&> timePrint conf.utcFormat
  annotate conf.closedStyle (pretty closedUtcMaybe)


formatTaskTags :: Config -> FullTask -> Doc AnsiStyle
formatTaskTags conf task = do
  let tags = fromMaybe [] task.tags
  hsep (tags <&> formatTag conf)


formatTaskNotes :: FullTask -> Doc AnsiStyle
formatTaskNotes task =
  if not $ P.null task.notes then "📝" else ""


formatTaskId :: Config -> Int -> FullTask -> Doc AnsiStyle
formatTaskId conf taskWidth task = do
  let id = pretty $ T.takeEnd taskWidth task.ulid
  annotate conf.idStyle id


formatTaskBody :: Config -> DateTime -> FullTask -> Doc AnsiStyle
formatTaskBody conf now task = pretty reviewIcon <> dueSoon <> body
  where
    dueIn offset =
      let dateMaybe = task.due_utc >>= parseUtc
      in  isJust dateMaybe && dateMaybe < Just (now `timeAdd` offset)
    grayOutIfDone doc =
      if isOpen
        then annotate conf.bodyStyle doc
        else annotate conf.bodyClosedStyle doc

    isOpen = isNothing task.closed_utc
    reviewIcon = case task.review_utc >>= parseUtc of
      Nothing -> "" :: Text
      Just date_ -> if date_ < now then "🔎 " else ""
    dueSoon = if dueIn mempty{durationHours = 24} && isOpen then "⚠️️ " else ""
    taskBody =
      reflow $
        if countChar '\n' task.body > 0
          then (task.body & T.takeWhile (/= '\n')) <> " ▼"
          else task.body
    body =
      if dueIn mempty && isOpen
        then annotate (colr conf Red) taskBody
        else grayOutIfDone taskBody


formatTaskOpenedUTC :: Config -> DateTime -> FullTask -> Doc AnsiStyle
formatTaskOpenedUTC conf _now task = do
  let
    dateMaybe = ulidTextToDateTime task.ulid
    formatTaskDate = T.pack . timePrint ISO8601_Date

  annotate (dateStyle conf) (pretty $ maybe "bad Ulid" formatTaskDate dateMaybe)


formatTaskAge :: Config -> DateTime -> FullTask -> Doc AnsiStyle
formatTaskAge conf now task = do
  let
    dateMaybe = ulidTextToDateTime task.ulid
    formatTaskDuration =
      timeDiff now
        >>> formatDuration
        >>> T.center (colToWidth conf 0 AgeCol) ' '
        >>> T.replace ".0" "  "

  annotate
    (dateStyle conf)
    (pretty $ maybe "bad Ulid" formatTaskDuration dateMaybe)


colToWidth :: Config -> Int -> Column -> Int
colToWidth conf idColWidth = \case
  IdCol -> idColWidth
  PrioCol -> conf.prioWidth
  OpenedUTCCol -> conf.dateWidth
  AgeCol -> 6
  BodyCol -> conf.bodyWidth
  EmptyCol -> 0


formatTaskLine :: Config -> DateTime -> Int -> FullTask -> Doc AnsiStyle
formatTaskLine conf now idColWidth task = do
  let
    columns = conf.columns & P.filter (/= EmptyCol)
    multilineIndent = 2
    hangWidth =
      ( (columns & P.filter (/= BodyCol) <&> colToWidth conf idColWidth)
          <> [multilineIndent]
      )
        & P.intersperse 2
        & P.sum
    hhsep = concatWith (<++>)
    isEmptyDoc doc = show doc /= ("" :: Text)
    fields =
      columns
        & P.concatMap
          ( \case
              IdCol -> [formatTaskId conf idColWidth task]
              PrioCol -> [formatTaskPriority conf task]
              OpenedUTCCol -> [formatTaskOpenedUTC conf now task]
              AgeCol -> [formatTaskAge conf now task]
              BodyCol ->
                [ formatTaskBody conf now task
                , formatTaskDue conf task
                , formatTaskClose conf task
                , formatTaskTags conf task
                , formatTaskNotes task
                ]
              EmptyCol -> []
          )
  hang hangWidth $ hhsep $ P.filter isEmptyDoc fields


getIdLength :: Float -> Int
getIdLength numOfItems =
  -- TODO: Calculate idLength by total number of tasks, not just of the viewed
  let
    targetCollisionChance = 0.01 -- Targeted likelihood of id collisions
    sizeOfAlphabet = 32 -- Crockford's base 32 alphabet
  in
    ceiling (logBase sizeOfAlphabet (numOfItems / targetCollisionChance)) + 1


countTasks :: Config -> Connection -> Maybe [Text] -> IO (Doc AnsiStyle)
countTasks conf connection filterExpression = do
  let
    parserResults =
      readP_to_S filterExpsParser $
        T.unpack (unwords $ fromMaybe [""] filterExpression)
    filterMay = listToMaybe parserResults

  case filterMay of
    Nothing -> do
      [NumRows taskCount] <-
        query_ connection $
          Query $
            "SELECT count(1) FROM " <> quoteKeyword conf.tableName

      pure $ pretty taskCount
    Just (filterExps, _) -> do
      let
        ppInvalidFilter = \case
          (InvalidFilter error) ->
            dquotes (pretty error) <+> "is an invalid filter"
          (HasStatus Nothing) -> "Filter contains an invalid state value"
          _ -> "The functions should not be called with a valid function"
        errors = P.filter (not . isValidFilter) filterExps
        errorsDoc =
          if P.length errors > 0
            then
              Just $
                vsep (fmap (annotate (colr conf Red) . ppInvalidFilter) errors)
                  <> hardline
                  <> hardline
            else Nothing

      tasks <- query_ connection (getFilterQuery filterExps Nothing Nothing)
      pure $ errorsDoc & fromMaybe (pretty $ P.length (tasks :: [FullTask]))


-- TODO: Print number of remaining tasks and how to display them at the bottom
headTasks :: Config -> DateTime -> Connection -> Maybe Int -> IO (Doc AnsiStyle)
headTasks conf now connection availableLinesMb = do
  let taskCount = do
        let availableLines = availableLinesMb & fromMaybe 0
        if P.isJust availableLinesMb && availableLines < conf.headCount
          then availableLines
          else conf.headCount

  tasks <-
    queryNamed
      connection
      -- TODO: Add `wait_utc` < datetime('now')"
      [sql|
        SELECT *
        FROM tasks_view
        WHERE closed_utc IS NULL
        ORDER BY
          priority DESC,
          due_utc ASC,
          ulid DESC
        LIMIT :taskCount
      |]
      [":taskCount" := taskCount]

  formatTasksColor conf now (isJust availableLinesMb) tasks


newTasks ::
  Config ->
  DateTime ->
  Connection ->
  Maybe [Text] ->
  Maybe Int ->
  IO (Doc AnsiStyle)
newTasks conf now connection filterExp availableLinesMb = do
  let
    parserResults =
      readP_to_S filterExpsParser $
        T.unpack (unwords $ fromMaybe [""] filterExp)
    filterMay = listToMaybe parserResults

  case filterMay of
    Nothing -> do
      tasks <-
        queryNamed
          connection
          [sql|
            SELECT *
            FROM tasks_view
            ORDER BY ulid DESC
            LIMIT :taskCount
          |]
          [ ":taskCount" := case availableLinesMb of
              Nothing -> -1 -- No limit
              Just availableLines -> availableLines
          ]

      formatTasksColor conf now (isJust availableLinesMb) tasks
    --
    Just (filterExps, _) -> do
      let
        ppInvalidFilter = \case
          (InvalidFilter error) ->
            dquotes (pretty error) <+> "is an invalid filter"
          (HasStatus Nothing) -> "Filter contains an invalid state value"
          _ -> "The functions should not be called with a valid function"
        errors = P.filter (not . isValidFilter) filterExps

      if P.length errors > 0
        then
          pure $
            vsep (fmap (annotate (colr conf Red) . ppInvalidFilter) errors)
              <> hardline
              <> hardline
        else do
          tasks <-
            query_
              connection
              (getFilterQuery filterExps (Just "ulid DESC") availableLinesMb)
          formatTasksColor conf now (isJust availableLinesMb) tasks


listOldTasks ::
  Config -> DateTime -> Connection -> Maybe Int -> IO (Doc AnsiStyle)
listOldTasks conf now connection availableLinesMb = do
  tasks <-
    queryNamed
      connection
      [sql|
        SELECT *
        FROM tasks_view
        WHERE closed_utc IS NULL
        ORDER BY ulid ASC
        LIMIT :taskCount
      |]
      [ ":taskCount" := case availableLinesMb of
          Nothing -> -1 -- No limit
          Just availableLines -> availableLines
      ]

  formatTasksColor conf now (isJust availableLinesMb) tasks


openTasks ::
  Config ->
  DateTime ->
  Connection ->
  Maybe [Text] ->
  Maybe Int ->
  IO (Doc AnsiStyle)
openTasks conf now connection filterExpression availableLinesMb = do
  let
    parserResults =
      readP_to_S filterExpsParser $
        T.unpack (unwords $ fromMaybe [""] filterExpression)
    filterMay = listToMaybe parserResults

  case filterMay of
    Nothing -> do
      (tasks :: [FullTask]) <-
        queryNamed
          connection
          [sql|
            SELECT *
            FROM tasks_view
            WHERE closed_utc IS NULL
            ORDER BY priority DESC, due_utc ASC, ulid DESC
            LIMIT :taskCount
          |]
          [ ":taskCount" := case availableLinesMb of
              Nothing -> -1 -- No limit
              Just availableLines -> availableLines
          ]

      formatTasksColor conf now (isJust availableLinesMb) tasks
    --
    Just (filterExps, _) -> do
      let
        ppInvalidFilter = \case
          (InvalidFilter error) ->
            dquotes (pretty error) <+> "is an invalid filter"
          (HasStatus Nothing) -> "Filter contains an invalid state value"
          _ -> "The functions should not be called with a valid function"
        errors = P.filter (not . isValidFilter) filterExps

      if P.length errors > 0
        then
          pure $
            vsep (fmap (annotate (colr conf Red) . ppInvalidFilter) errors)
              <> hardline
              <> hardline
        else do
          let
            isStateExp = \case (HasStatus _) -> True; _ -> False
            filterExpWithOpen =
              if P.any isStateExp filterExps
                then filterExps
                else HasStatus (Just IsOpen) : filterExps
            sqlQuery =
              getFilterQuery
                filterExpWithOpen
                (Just "priority DESC, due_utc ASC, ulid DESC")
                availableLinesMb

          tasks <- query_ connection sqlQuery
          formatTasksColor conf now (isJust availableLinesMb) tasks


modifiedTasks ::
  Config ->
  DateTime ->
  Connection ->
  ListModifiedFlag ->
  Maybe Int ->
  IO (Doc AnsiStyle)
modifiedTasks conf now connection listModifiedFlag availableLinesMb = do
  tasks <-
    queryNamed
      connection
      [sql|
        SELECT *
        FROM tasks_view
        ORDER BY modified_utc Desc
        LIMIT :taskCount
      |]
      [ ":taskCount" := case availableLinesMb of
          Nothing -> -1 -- No limit
          Just availableLines -> availableLines
      ]

  let
    filterModified =
      P.filter
        ( \task ->
            removeNSec (ulidTextToDateTime task.ulid)
              /= parseUtc task.modified_utc
        )

    removeNSec :: Maybe DateTime -> Maybe DateTime
    removeNSec mDateTime =
      case mDateTime of
        Just dateTime ->
          Just $
            dateTime{dtTime = (dtTime dateTime){todNSec = 0}}
        Nothing -> Nothing

    filteredTasks =
      case listModifiedFlag of
        AllItems -> tasks
        ModifiedItemsOnly -> filterModified tasks

  formatTasksColor conf now (isJust availableLinesMb) filteredTasks


overdueTasks ::
  Config -> DateTime -> Connection -> Maybe Int -> IO (Doc AnsiStyle)
overdueTasks conf now connection availableLinesMb = do
  tasks <-
    queryNamed
      connection
      [sql|
        SELECT *
        FROM tasks_view
        WHERE
          closed_utc IS NULL AND
          due_utc < datetime('now')
        ORDER BY
          priority DESC,
          due_utc ASC,
          ulid Desc
        LIMIT :taskCount
      |]
      [ ":taskCount" := case availableLinesMb of
          Nothing -> -1 -- No limit
          Just availableLines -> availableLines
      ]

  formatTasksColor conf now (isJust availableLinesMb) tasks


doneTasks :: Config -> DateTime -> Connection -> Maybe Int -> IO (Doc AnsiStyle)
doneTasks conf now connection availableLinesMb = do
  tasks <-
    queryNamed
      connection
      [sql|
        SELECT *
        FROM tasks_view
        WHERE
          closed_utc IS NOT NULL AND
          state == 'Done'
        ORDER BY closed_utc DESC
        LIMIT :taskCount
      |]
      [ ":taskCount" := case availableLinesMb of
          Nothing -> -1 -- No limit
          Just availableLines -> availableLines
      ]

  formatTasksColor conf now (isJust availableLinesMb) tasks


obsoleteTasks ::
  Config -> DateTime -> Connection -> Maybe Int -> IO (Doc AnsiStyle)
obsoleteTasks conf now connection availableLinesMb = do
  tasks <-
    queryNamed
      connection
      [sql|
        SELECT *
        FROM tasks_view
        WHERE
          closed_utc IS NOT NULL AND
          state == 'Obsolete'
        ORDER BY ulid DESC
        LIMIT :taskCount
      |]
      [ ":taskCount" := case availableLinesMb of
          Nothing -> -1 -- No limit
          Just availableLines -> availableLines
      ]

  formatTasksColor conf now (isJust availableLinesMb) tasks


deletableTasks ::
  Config -> DateTime -> Connection -> Maybe Int -> IO (Doc AnsiStyle)
deletableTasks conf now connection availableLinesMb = do
  tasks <-
    queryNamed
      connection
      [sql|
        SELECT *
        FROM tasks_view
        WHERE
          closed_utc IS NOT NULL
          AND state == 'Deletable'
        ORDER BY ulid DESC
        LIMIT :taskCount
      |]
      [ ":taskCount" := case availableLinesMb of
          Nothing -> -1 -- No limit
          Just availableLines -> availableLines
      ]
  formatTasksColor conf now (isJust availableLinesMb) tasks


listRepeating ::
  Config -> DateTime -> Connection -> Maybe Int -> IO (Doc AnsiStyle)
listRepeating conf now connection availableLinesMb = do
  tasks <-
    queryNamed
      connection
      [sql|
        SELECT *
        FROM tasks_view
        WHERE repetition_duration IS NOT NULL
        ORDER BY repetition_duration Desc
        LIMIT :taskCount
      |]
      [ ":taskCount" := case availableLinesMb of
          Nothing -> -1 -- No limit
          Just availableLines -> availableLines
      ]

  formatTasksColor conf now (isJust availableLinesMb) tasks


listRecurring ::
  Config -> DateTime -> Connection -> Maybe Int -> IO (Doc AnsiStyle)
listRecurring conf now connection availableLinesMb = do
  tasks <-
    queryNamed
      connection
      [sql|
        SELECT *
        FROM tasks_view
        WHERE recurrence_duration IS NOT NULL
        ORDER BY recurrence_duration DESC
        LIMIT :taskCount
      |]
      [ ":taskCount" := case availableLinesMb of
          Nothing -> -1 -- No limit
          Just availableLines -> availableLines
      ]

  formatTasksColor conf now (isJust availableLinesMb) tasks


listReady ::
  Config -> DateTime -> Connection -> Maybe P.Int -> IO (Doc AnsiStyle)
listReady conf now connection availableLinesMb = do
  tasks <-
    queryNamed
      connection
      [sql|
        SELECT *
        FROM tasks_view
        WHERE
          (ready_utc IS NULL OR
            (ready_utc IS NOT NULL AND ready_utc < datetime('now'))
          ) AND
          waiting_utc IS NULL AND
          ready_utc IS NULL AND
          closed_utc IS NULL
        ORDER BY
          priority DESC,
          due_utc ASC,
          ulid DESC
        LIMIT :taskCount
      |]
      [ ":taskCount" := case availableLinesMb of
          Nothing -> -1 -- No limit
          Just availableLines -> availableLines
      ]

  formatTasksColor conf now (isJust availableLinesMb) tasks


listWaiting ::
  Config -> DateTime -> Connection -> Maybe Int -> IO (Doc AnsiStyle)
listWaiting conf now connection availableLinesMb = do
  tasks <-
    queryNamed
      connection
      [sql|
        SELECT *
        FROM tasks_view
        WHERE closed_utc IS NULL
          AND waiting_utc IS NOT NULL
          AND (review_utc > datetime('now') OR review_utc IS NULL)
        ORDER BY waiting_utc DESC
        LIMIT :taskCount
      |]
      [ ":taskCount" := case availableLinesMb of
          Nothing -> -1 -- No limit
          Just availableLines -> availableLines
      ]

  formatTasksColor conf now (isJust availableLinesMb) tasks


listAll :: Config -> DateTime -> Connection -> Maybe Int -> IO (Doc AnsiStyle)
listAll conf now connection availableLinesMb = do
  tasks <-
    queryNamed
      connection
      [sql|
        SELECT *
        FROM tasks_view
        ORDER BY ulid ASC
        LIMIT :taskCount
      |]
      [ ":taskCount" := case availableLinesMb of
          Nothing -> -1 -- No limit
          Just availableLines -> availableLines
      ]

  formatTasksColor conf now (isJust availableLinesMb) tasks


listNoTag :: Config -> DateTime -> Connection -> Maybe Int -> IO (Doc AnsiStyle)
listNoTag conf now connection availableLinesMb = do
  tasks <-
    queryNamed
      connection
      [sql|
        SELECT *
        FROM tasks_view
        WHERE
          closed_utc IS NULL AND
          tags IS NULL
        ORDER BY
          priority DESC,
          due_utc ASC,
          ulid DESC
        LIMIT :taskCount
      |]
      [ ":taskCount" := case availableLinesMb of
          Nothing -> -1 -- No limit
          Just availableLines -> availableLines
      ]

  formatTasksColor conf now (isJust availableLinesMb) tasks


getWithTag ::
  Connection ->
  Maybe DerivedState ->
  Maybe Int ->
  [Text] ->
  IO [FullTask]
getWithTag connection stateMaybe availableLinesMb tags = do
  let
    tagQuery = case tags of
      [] -> ""
      _ ->
        tags
          <&> (\t -> "tag LIKE '" <> t <> "'")
          & T.intercalate " OR "
          & ("AND " <>)

    stateQuery = case stateMaybe of
      Nothing -> ""
      Just derivedState -> "AND " <> derivedStateToQuery derivedState

    -- `WHERE TRUE` simplifies adding additional filters with "AND"
    ulidsQuery =
      "\
      \SELECT tasks.ulid \n\
      \FROM tasks \n\
      \LEFT JOIN task_to_tag ON tasks.ulid IS task_to_tag.task_ulid \n\
      \WHERE TRUE \n\
      \"
        <> tagQuery
        <> " \
           \"
        <> stateQuery
        <> " \
           \GROUP BY tasks.ulid \
           \HAVING count(tag) = "
        <> show (P.length tags)

    mainQuery =
      FullTask.selectQuery
        <> "\
           \FROM ("
        <> Query ulidsQuery
        <> ") tasks1\n\
           \LEFT JOIN tasks_view ON tasks1.ulid IS tasks_view.ulid\n\
           \ORDER BY \n\
           \  priority DESC,\n\
           \  due_utc ASC,\n\
           \  ulid DESC\n\
           \LIMIT "
        <> Query
          ( show @Int $ case availableLinesMb of
              Nothing -> -1 -- No limit
              Just availableLines -> availableLines
          )

  query_ connection mainQuery


listWithTag ::
  Config -> DateTime -> Connection -> [Text] -> Maybe Int -> IO (Doc AnsiStyle)
listWithTag conf now connection tags availableLinesMb = do
  tasks <- getWithTag connection Nothing availableLinesMb tags
  formatTasksColor conf now (isJust availableLinesMb) 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
  formatTasksColor conf now False tasks


runSql :: Config -> Text -> IO (Doc AnsiStyle)
runSql conf sqlQuery = do
  result <-
    readProcess
      "sqlite3"
      [ conf.dataDir </> conf.dbName
      , ".headers on"
      , ".mode csv"
      , ".separator , '\n'"
      , T.unpack sqlQuery
      ]
      []
  -- Remove trailing newline
  pure $ pretty (T.dropEnd 1 $ T.pack result)


data FilterExp
  = HasTag Text
  | NotTag Text
  | HasDue Text
  | HasStatus (Maybe DerivedState) -- Should be `Either`
  | InvalidFilter Text
  deriving (Show)


tagParser :: ReadP FilterExp
tagParser = do
  _ <- char '+'
  aTag <- munch (not . isSpace)
  pure $ HasTag $ T.pack aTag


notTagParser :: ReadP FilterExp
notTagParser = do
  _ <- char '-'
  aTag <- munch (not . isSpace)
  pure $ NotTag $ T.pack aTag


dueParser :: ReadP FilterExp
dueParser = do
  _ <- string "due:"
  utcStr <- munch (not . isSpace)
  pure $ HasDue $ T.pack utcStr


stateParser :: ReadP FilterExp
stateParser = do
  _ <- string "state:"
  stateStr <- munch (not . isSpace)
  pure $ HasStatus $ textToDerivedState $ T.pack stateStr


filterExpParser :: ReadP FilterExp
filterExpParser =
  do
    tagParser
    <++ notTagParser
    <++ dueParser
    <++ stateParser
    <++ (InvalidFilter . T.pack <$> munch1 (not . isSpace))


filterExpsParser :: ReadP [FilterExp]
filterExpsParser = do
  val <- sepBy1 filterExpParser skipSpaces
  eof
  return val


parseFilterExps :: Text -> IO ()
parseFilterExps input =
  P.print $ readP_to_S filterExpsParser $ T.unpack input


{-| Returns (operator, where-query) tuple
 TODO: Should be `FilterExp -> Maybe (Text, Text)`
-}
filterToSql :: FilterExp -> (Text, Text)
filterToSql = \case
  HasTag tag -> ("INTERSECT", "tag LIKE " <> quoteText tag)
  NotTag tag -> ("EXCEPT", "tag LIKE " <> quoteText tag)
  HasDue utc -> ("INTERSECT", "due_utc < datetime(" <> quoteText utc <> ")")
  HasStatus (Just taskState) -> ("INTERSECT", derivedStateToQuery taskState)
  -- Following cases should never be called, as they are filtered out
  HasStatus Nothing -> ("", "")
  InvalidFilter _ -> ("", "")


isValidFilter :: FilterExp -> Bool
isValidFilter = \case
  InvalidFilter _ -> False
  HasStatus Nothing -> False
  _ -> True


runFilter ::
  Config -> DateTime -> Connection -> [Text] -> Maybe Int -> IO (Doc AnsiStyle)
runFilter conf now connection exps availableLinesMb = do
  let
    parserResults = readP_to_S filterExpsParser $ T.unpack $ unwords exps
    filterHelp =
      "Filter expressions must be a list of key[:value] entries."
        <> hardline
    dieWithError err = do
      hPutDoc stderr $ annotate (colr conf Red) err
      exitFailure

  case parserResults of
    [(filterExps, _)] -> do
      let
        ppInvalidFilter = \case
          (InvalidFilter error) ->
            dquotes (pretty error)
              <+> "is an invalid filter."
                <> hardline
                <> filterHelp
          (HasStatus Nothing) ->
            "Filter contains an invalid state value"
          _ ->
            "The functions should not be called with a valid function"
        errors = P.filter (not . isValidFilter) filterExps
        sqlQuery = getFilterQuery filterExps Nothing availableLinesMb

      tasks <- query_ connection sqlQuery

      if P.length errors > 0
        then dieWithError $ vsep (fmap ppInvalidFilter errors)
        else
          if P.length tasks <= 0
            then pure "No tasks available for the given filter."
            else formatTasksColor conf now False tasks
    _ -> dieWithError filterHelp


-- TODO: Increase performance of this query
getFilterQuery :: [FilterExp] -> Maybe Text -> Maybe Int -> Query
getFilterQuery filterExps orderByMb availableLinesMb = do
  let
    filterTuple =
      filterToSql <$> P.filter isValidFilter filterExps

    queries =
      filterTuple <&> \(operator, whereQuery) ->
        operator
          <> "\n\
             \SELECT tasks.ulid\n\
             \FROM tasks\n\
             \LEFT JOIN task_to_tag ON tasks.ulid IS task_to_tag.task_ulid\n\
             \WHERE "
          <> whereQuery
          <> "\n\
             \GROUP BY tasks.ulid"

    ulidsQuery =
      "SELECT tasks.ulid FROM tasks\n"
        <> unlines queries

    orderBy = Query $ case orderByMb of
      Nothing ->
        "ORDER BY \n\
        \  priority DESC,\n\
        \  due_utc ASC,\n\
        \  ulid DESC\n"
      Just orderByTxt ->
        "ORDER BY \n" <> orderByTxt <> "\n"

  FullTask.selectQuery
    <> "FROM ("
    <> Query ulidsQuery
    <> ") tasks1\n\
       \LEFT JOIN tasks_view ON tasks1.ulid IS tasks_view.ulid\n"
    <> orderBy
    <> Query
      ( "LIMIT "
          <> ( show @P.Int $ case availableLinesMb of
                Nothing -> -1 -- No limit
                Just availableLines -> availableLines
             )
          <> "\n"
      )


columnToDoc :: Config -> Int -> Column -> Doc AnsiStyle
columnToDoc conf idColWidth = do
  let strong = bold <> underlined

  \case
    IdCol ->
      annotate
        (conf.idStyle <> strong)
        (fill idColWidth "Id")
    PrioCol ->
      annotate
        (conf.priorityStyle <> strong)
        (fill (colToWidth conf idColWidth PrioCol) "Prio")
    OpenedUTCCol ->
      annotate
        (conf.dateStyle <> strong)
        (fill (colToWidth conf idColWidth OpenedUTCCol) "Opened UTC")
    AgeCol ->
      annotate
        (conf.dateStyle <> strong)
        (fill (colToWidth conf idColWidth AgeCol) "Age")
    BodyCol ->
      annotate
        (conf.bodyStyle <> strong)
        (fill (colToWidth conf idColWidth BodyCol) "Body")
    EmptyCol ->
      mempty


formatTasks :: Config -> DateTime -> Bool -> [FullTask] -> Doc AnsiStyle
formatTasks conf now isTruncated tasks =
  if P.length tasks == 0
    then pretty noTasksWarning
    else do
      let
        idColWidth = getIdLength $ fromIntegral $ P.length tasks
        docHeader =
          concatWith (<++>) $
            ( conf.columns
                & P.filter (/= EmptyCol)
                <&> columnToDoc conf idColWidth
            )
              <> [line]

      docHeader
        <> vsep (fmap (formatTaskLine conf now idColWidth) tasks)
        <> line
        <> if isTruncated
          then
            annotate
              (colr conf Yellow)
              ( "This list is truncated. "
                  <> "List all by piping into `cat` or `less`."
              )
          else mempty


formatTasksColor ::
  Config -> DateTime -> Bool -> [FullTask] -> IO (Doc AnsiStyle)
formatTasksColor conf now isTruncated tasks = do
  confNorm <- applyColorMode conf
  pure $ formatTasks confNorm now isTruncated tasks


getProgressBar :: Config -> Integer -> Double -> Doc AnsiStyle
getProgressBar conf maxWidthInChars progress =
  let
    barWidth = floor (progress * fromInteger maxWidthInChars)
    remainingWidth = fromIntegral $ maxWidthInChars - barWidth
  in
    annotate
      (bgColrDull conf Green <> colrDull conf Green)
      (pretty $ P.take (fromIntegral barWidth) $ P.repeat '#')
      <>
      -- (annotate (bgColrDull conf Green) $ fill (fromIntegral barWidth) "" <>
      annotate (bgColrDull conf Black) (fill remainingWidth "")


formatTagLine ::
  Config -> Int -> (Text, Integer, Integer, Double) -> Doc AnsiStyle
formatTagLine conf maxTagLength (tag, open_count, closed_count, progress) =
  let
    barWidth = toInteger $ progressBarWidth conf
    progressPercentage =
      if progress == 0
        then "     "
        else
          pretty
            ( T.justifyRight 3 ' ' $
                T.pack $
                  showFFloat (Just 0) (progress * 100) ""
            )
            <+> "%"
  in
    fill maxTagLength (pretty tag)
      <++> pretty (T.justifyRight (T.length "open") ' ' $ show open_count)
      <++> pretty (T.justifyRight (T.length "closed") ' ' $ show closed_count)
      <++> progressPercentage
      <+> getProgressBar conf barWidth progress


formatTags :: Config -> [(Text, Integer, Integer, Double)] -> Doc AnsiStyle
formatTags conf tagTuples = do
  let
    percWidth = 6 -- Width of e.g. 100 %
    progressWith = conf.progressBarWidth + percWidth
    firstOf4 (a, _, _, _) = a
    maxTagLength =
      tagTuples
        <&> (T.length . firstOf4)
        & P.maximum

  if P.null tagTuples
    then
      annotate
        (colr conf Yellow)
        "⚠️ No tags available"
    else
      annotate (bold <> underlined) (fill maxTagLength "Tag")
        <++> annotate (bold <> underlined) "Open"
        <++> annotate (bold <> underlined) "Closed"
        <++> annotate (bold <> underlined) (fill progressWith "Progress")
        <> line
        <> vsep (fmap (formatTagLine conf maxTagLength) tagTuples)


listTags :: Config -> Connection -> IO (Doc AnsiStyle)
listTags conf connection = do
  tags <- query_ connection $ Query "SELECT * FROM tags"

  pure $ formatTags conf tags


listProjects :: Config -> Connection -> IO (Doc AnsiStyle)
listProjects conf connection = do
  tags <-
    query_
      connection
      [sql|
        SELECT *
        FROM tags
        WHERE
          "open" > 0 AND
          closed > 0
      |]

  pure $
    if P.null tags
      then
        annotate (colr conf Yellow) $
          "⚠️ No projects available yet. "
            <> "Tag some tasks to populate this list."
      else formatTags conf tags


listNotes :: Config -> Connection -> IO (Doc AnsiStyle)
listNotes conf connection = do
  (notes :: [TaskToNote]) <-
    query_
      connection
      [sql|
        SELECT ulid, task_ulid, note
        FROM task_to_note
        ORDER BY ulid DESC
      |]

  let
    taskIdWidth = 7 -- TODO: Use dynamic width
    noteWidth = getIdLength $ fromIntegral $ P.length notes
    docHeader =
      annotate
        (conf.idStyle <> bold <> underlined)
        (fill taskIdWidth "Task ID")
        <++> annotate
          (conf.idStyle <> bold <> underlined)
          (fill noteWidth "ID")
        <++> annotate (conf.dateStyle <> bold <> underlined) "Created UTC"
        <++> annotate (bold <> underlined) "Note"
        <++> line

    showNote note =
      annotate
        conf.idStyle
        (fill 7 $ pretty $ T.takeEnd taskIdWidth note.task_ulid)
        <++> annotate
          conf.idStyle
          (fill noteWidth $ pretty $ T.takeEnd noteWidth note.ulid)
        <++> annotate
          conf.dateStyle
          ( note.ulid
              & ulidTextToDateTime
              <&> timePrint ISO8601_Date
              & pretty
          )
        <++> pretty note.note
        <> line

  pure $ docHeader <> vsep (notes <&> showNote)


getStats :: Config -> Connection -> IO (Doc AnsiStyle)
getStats _ connection = do
  [NumRows numOfTasksTotal] <-
    query_ connection $
      Query "SELECT count(1) FROM tasks"
  [NumRows numOfTasksOpen] <-
    query_ connection $
      Query "SELECT count(1) FROM tasks WHERE closed_utc IS NULL"
  [NumRows numOfTasksClosed] <-
    query_ connection $
      Query "SELECT count(1) FROM tasks WHERE closed_utc IS NOT NULL"
  [NumRows numOfTasksDone] <-
    query_ connection $
      Query "SELECT count(1) FROM tasks WHERE state IS 'Done'"
  [NumRows numOfTasksObsolete] <-
    query_ connection $
      Query "SELECT count(1) FROM tasks WHERE state IS 'Obsolete'"
  [NumRows numOfTasksDeletable] <-
    query_ connection $
      Query "SELECT count(1) FROM tasks WHERE state IS 'Deletable'"

  let
    widthKey = 12
    widthValue = max 5 $ fromIntegral $ numDigits 10 numOfTasksTotal
    formatLine (name :: Text) (numTasks :: Integer) =
      let
        numTotalInt :: Double = fromIntegral numOfTasksTotal
        numTasksInt :: Double = fromIntegral numTasks
        share = T.pack $ showFFloat (Just 3) (numTasksInt / numTotalInt) ""
      in
        fill widthKey (pretty name)
          <++> fill
            widthValue
            (pretty $ T.justifyRight widthValue ' ' $ show numTasks)
          <++> pretty share

  pure $
    annotate (bold <> underlined) (fill widthKey "State")
      <++> annotate (bold <> underlined) (fill widthValue "Value")
      <++> annotate (bold <> underlined) "Share"
      <> line
      <> vsep
        [ formatLine "Any" numOfTasksTotal
        , formatLine "Open" numOfTasksOpen
        , formatLine "Closed" numOfTasksClosed
        , formatLine "└─ Done" numOfTasksDone
        , formatLine "└─ Obsolete" numOfTasksObsolete
        , formatLine "└─ Deletable" numOfTasksDeletable
        ]