hush,

isJust,

optional,

putErrLn,

rightToMaybe,

show,

toStrict,

($),

(&),

(+),

(.),

(<$>),

(<&>),

import Data.ULID (ULID, ulidFromInteger)

import Data.ULID.TimeStamp (getULIDTimeStamp)

import Data.Vector qualified as V

import Data.Yaml as Yaml (ParseException, decodeEither')

import Data.Yaml (ParseException (InvalidYaml), YamlException (YamlException, YamlParseException), YamlMark (YamlMark))

import Data.Yaml qualified as Yaml

import Database.SQLite.Simple as Sql (Connection, query_)

import FullTask (FullTask)

import Lib (

| NoPreEdit

{-| Edit the task until it is valid YAML and can be decoded.

| Return the the tuple `(task, valid YAML content)`

-}

editUntilValidYaml

:: PreEdit

-> Connection

-> P.ByteString

-> P.ByteString

-> IO (Either ParseException (ImportTask, P.ByteString))

editUntilValidYaml preEdit conn initialYaml wipYaml = do

yamlAfterEdit <- case preEdit of

ApplyPreEdit editFunc -> pure $ editFunc wipYaml

NoPreEdit -> runUserEditorDWIM yamlTemplate wipYaml

if yamlAfterEdit == initialYaml

then pure $ Left $ InvalidYaml $ Just $ YamlException "⚠️ Nothing changed"

else do

case yamlAfterEdit & Yaml.decodeEither' of

Left error -> do

case error of

-- Adjust the line and column numbers to be 1-based

InvalidYaml

(Just (YamlParseException prblm ctxt (YamlMark idx line col))) ->

let yamlMark = YamlMark (idx + 1) (line + 1) (col + 1)

in putErrLn $

Yaml.prettyPrintParseException

( InvalidYaml

(Just (YamlParseException prblm ctxt yamlMark))

)

<> "\n"

_ ->

putErrLn $ Yaml.prettyPrintParseException error <> "\n"

editUntilValidYaml preEdit conn initialYaml yamlAfterEdit

---

Right newTask -> do

pure $ Right (newTask, yamlAfterEdit)

editTaskByTask :: PreEdit -> Connection -> Task -> IO (Doc AnsiStyle)

editTaskByTask preEdit conn taskToEdit = do

taskYaml <- taskToEditableYaml conn taskToEdit

newContent <- case preEdit of

ApplyPreEdit editFunc -> pure $ editFunc taskYaml

NoPreEdit -> runUserEditorDWIM yamlTemplate taskYaml

if newContent == taskYaml

then

pure $

"⚠️ Nothing changed" <+> hardline

else do

taskYamlTupleRes <- editUntilValidYaml preEdit conn taskYaml taskYaml

case taskYamlTupleRes of

Left error -> pure $ pretty $ Yaml.prettyPrintParseException error

Right (importTaskRecord, newContent) -> do

effectiveUserName <- getEffectiveUserName

now <- getULIDTimeStamp <&> (show >>> T.toLower)

let

parseMetadata :: Value -> Parser Bool

parseMetadata val = case val of

hasMetadata =

parseMaybe parseMetadata

=<< (rightToMaybe $ Yaml.decodeEither' newContent :: Maybe Value)

=<< rightToMaybe (Yaml.decodeEither' newContent)

taskFixed =

importTaskRecord.task

{ Task.user =

if importTaskRecord.task.user == ""

then T.pack effectiveUserName

else importTaskRecord.task.user

, Task.metadata =

if hasMetadata == Just True

then importTaskRecord.task.metadata

else Nothing

, -- Set to previous value to force SQL trigger to update it

Task.modified_utc = taskToEdit.modified_utc

}

notesCorrectUtc =

importTaskRecord.notes

<&> ( \note ->

note

{ Note.ulid =

if zeroUlidTxt `T.isPrefixOf` note.ulid

then note.ulid & T.replace zeroUlidTxt now

else note.ulid

}

)

decodeResult :: Either ParseException ImportTask

decodeResult = Yaml.decodeEither' newContent

updateTask conn taskFixed

case decodeResult of

Left error -> die $ show error <> " in task \n" <> show newContent

Right importTaskRecord -> do

effectiveUserName <- getEffectiveUserName

now <- getULIDTimeStamp <&> (show >>> T.toLower)

let

taskFixed =

importTaskRecord.task

{ Task.user =

if importTaskRecord.task.user == ""

then T.pack effectiveUserName

else importTaskRecord.task.user

, Task.metadata =

if hasMetadata == Just True

then importTaskRecord.task.metadata

else Nothing

, -- Set to previous value to force SQL trigger to update it

Task.modified_utc = taskToEdit.modified_utc

}

notesCorrectUtc =

importTaskRecord.notes

<&> ( \note ->

note

{ Note.ulid =

if zeroUlidTxt `T.isPrefixOf` note.ulid

then note.ulid & T.replace zeroUlidTxt now

else note.ulid

}

)

updateTask conn taskFixed

-- TODO: Remove after it was added to `createSetClosedUtcTrigger`

-- Update again with the same `state` field to avoid firing

-- SQL trigger which would overwrite the `closed_utc` field.

P.when (isJust taskFixed.closed_utc) $ do

now_ <- dateCurrent

updateTask conn taskFixed{Task.modified_utc = show @DateTime now_}

tagWarnings <- insertTags conn Nothing taskFixed importTaskRecord.tags

noteWarnings <- insertNotes conn Nothing taskFixed notesCorrectUtc

pure $

tagWarnings

<$$> noteWarnings

<$$> "✏️ Edited task"

<+> dquotes (pretty taskFixed.body)

<+> "with ulid"

<+> dquotes (pretty taskFixed.ulid)

<+> hardline

-- TODO: Remove after it was added to `createSetClosedUtcTrigger`

-- Update again with the same `state` field to avoid firing

-- SQL trigger which would overwrite the `closed_utc` field.

P.when (isJust taskFixed.closed_utc) $ do

now_ <- dateCurrent

updateTask conn taskFixed{Task.modified_utc = show @DateTime now_}

tagWarnings <- insertTags conn Nothing taskFixed importTaskRecord.tags

noteWarnings <- insertNotes conn Nothing taskFixed notesCorrectUtc

pure $

tagWarnings

<$$> noteWarnings

<$$> "✏️ Edited task"

<+> dquotes (pretty taskFixed.body)

<+> "with ulid"

<+> dquotes (pretty taskFixed.ulid)

<+> hardline

editTask :: Config -> Connection -> IdText -> IO (Doc AnsiStyle)