content: {-# LANGUAGE QuasiQuotes #-}
  {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
  
  {-# HLINT ignore "Use uncurry" #-}
  
  {-|
  Datatype to represent a task as stored in the `tasks` table
  -}
  module Task where
  
  import Protolude (
    Applicative ((<*>)),
    Either (Left, Right),
    Enum (toEnum),
    Eq ((==)),
    Float,
    Functor (fmap),
    Generic,
    Hashable,
    Maybe (..),
    Ord ((<), (>)),
    Read,
    Semigroup ((<>)),
    Show,
    decodeUtf8,
    fst,
    otherwise,
    pure,
    show,
    snd,
    ($),
    (&),
    (&&),
    (.),
    (<$>),
    (<&>),
   )
  import Protolude qualified as P
  
  import Data.Aeson as Aeson (
    FromJSON,
    ToJSON,
    Value (Object),
    eitherDecodeStrictText,
    encode,
   )
  import Data.Aeson.Key as Key (fromText)
  import Data.Aeson.KeyMap as KeyMap (fromList, insert)
  import Data.ByteString.Lazy qualified as BSL
  import Data.Csv qualified as Csv
  import Data.Generics (Data)
  import Data.Hourglass (DateTime, timePrint)
  import Data.Text (Text, pack)
  import Data.Text qualified as T
  import Data.Yaml as Yaml (encode)
  import Database.SQLite.Simple as Sql (
    FromRow (..),
    ResultError (ConversionFailed),
    SQLData (SQLText),
    ToRow (toRow),
    field,
   )
  import Database.SQLite.Simple.FromField as Sql.FromField (
    FromField (..),
    returnError,
   )
  import Database.SQLite.Simple.Internal (Field (Field))
  import Database.SQLite.Simple.Ok (Ok (Ok))
  import Database.SQLite.Simple.ToField as Sql.ToField (ToField (..), toField)
  import Generic.Random (genericArbitrary, genericArbitraryU, (%))
  import Prettyprinter (Pretty (pretty))
  import Test.QuickCheck (Arbitrary (arbitrary))
  import Test.QuickCheck.Instances.Text ()
  
  import Config (defaultConfig, utcFormat)
  import Control.Arrow ((>>>))
  import Database.SQLite.Simple (
    Connection,
    Only (Only),
    SQLData (SQLNull),
    query,
   )
  import Database.SQLite.Simple.QQ (sql)
  
  
  data TaskState
    = Done
    | Obsolete
    | Deletable
    deriving (Eq, Enum, Generic, Ord, Read, Show, Data)
  
  
  instance Arbitrary TaskState where
    arbitrary = genericArbitrary (4 % 2 % 1 % ())
  
  
  instance Sql.FromField.FromField TaskState where
    fromField f@(Field (SQLText txt) _) =
      case textToTaskState txt of
        Just val -> Ok val
        Nothing ->
          returnError ConversionFailed f $
            T.unpack $
              "expecting a valid TaskState and not \"" <> txt <> "\""
    fromField f =
      returnError ConversionFailed f "expecting SQLText column type"
  
  
  instance Sql.ToField.ToField TaskState where
    toField = SQLText . show
  
  
  instance FromJSON TaskState
  instance ToJSON TaskState
  
  
  instance Csv.ToRecord TaskState
  instance Csv.ToNamedRecord TaskState
  
  
  instance Csv.ToField TaskState where
    toField = show
  
  
  instance Hashable TaskState
  
  
  stateDefault :: TaskState
  stateDefault = toEnum 0
  
  
  stateOptions :: Text
  stateOptions =
    T.intercalate "," $
      fmap (("'" <>) . (<> "'") . show) [stateDefault ..]
  
  
  textToTaskState :: Text -> Maybe TaskState
  textToTaskState txt =
    let
      func t
        | t `P.elem` ["done", "completed", "finished", "fixed"] = Just Done
        | t `P.elem` ["obsolete"] = Just Obsolete
        | t
            `P.elem` [ "deletable"
                     , "deleted"
                     , "removable"
                     , "removed"
                     ] =
            Just Deletable
        | otherwise = Nothing
      txtLower = T.toLower txt
    in
      func txtLower
  
  
  data DerivedState
    = IsOpen
    | IsClosed
    | IsAsleep
    | IsAwake
    | IsReady
    | IsWaiting
    | IsReview
    | IsDone
    | IsObsolete
    | IsDeletable
    | IsBlocked
    deriving (Eq, Generic, Show)
  
  
  instance Arbitrary DerivedState where
    arbitrary = genericArbitraryU
  
  
  {-| A tuple of (Primary State, Secondary State)
   | Check out tasklite.org/concepts for a
   | detailed explanation of the different states
   | and how they relate to each other
  -}
  type StateHierarchy = (DerivedState, DerivedState)
  
  
  instance {-# OVERLAPS #-} Pretty StateHierarchy where
    pretty stateH =
      ( if fst stateH == snd stateH
          then show $ fst stateH
          else
            [fst stateH, snd stateH]
              <&> show
              & T.intercalate " and "
      )
        & T.replace "Is" ""
        & pretty
  
  
  textToDerivedState :: Text -> Maybe DerivedState
  textToDerivedState =
    T.toLower >>> \case
      "open" -> Just IsOpen
      "closed" -> Just IsClosed
      "asleep" -> Just IsAsleep
      "awake" -> Just IsAwake
      "ready" -> Just IsReady
      "waiting" -> Just IsWaiting
      "review" -> Just IsReview
      "done" -> Just IsDone
      "obsolete" -> Just IsObsolete
      "deletable" -> Just IsDeletable
      "blocked" -> Just IsBlocked
      _ -> Nothing
  
  
  derivedStateToQuery :: DerivedState -> Text
  derivedStateToQuery = \case
    IsOpen -> "closed_utc is null"
    IsClosed -> "closed_utc is not null"
    IsAsleep ->
      "awake_utc > datetime('now') and \
      \(ready_utc is null or ready_utc > datetime('now')) \
      \and closed_utc is null"
    IsAwake ->
      "awake_utc < datetime('now') and \
      \(ready_utc is null or ready_utc > datetime('now')) \
      \and closed_utc is null"
    IsReady ->
      "(awake_utc is null or awake_utc < datetime('now')) \
      \and ready_utc < datetime('now') \
      \and closed_utc is null"
    IsWaiting ->
      "waiting_utc is not null and \
      \(review_utc is null or review_utc > datetime('now')) \
      \and closed_utc is null"
    IsReview ->
      "waiting_utc is not null and \
      \(review_utc is null or review_utc < datetime('now')) \
      \and closed_utc is null"
    IsDone -> "closed_utc is not null and state is 'Done'"
    IsObsolete -> "closed_utc is not null and state is 'Obsolete'"
    IsDeletable -> "closed_utc is not null and state is 'Deletable'"
    IsBlocked -> "" -- TODO
  
  
  getStateHierarchy :: DateTime -> Task -> StateHierarchy
  getStateHierarchy now task = do
    let
      nowTxt = pack $ timePrint (utcFormat defaultConfig) now
  
    case Task.state task of
      Just Done -> (IsClosed, IsDone)
      Just Obsolete -> (IsClosed, IsObsolete)
      Just Deletable -> (IsClosed, IsDeletable)
      Nothing -> case closed_utc task of
        Just _ -> (IsClosed, IsClosed)
        Nothing -> case review_utc task of
          Just val ->
            if val > nowTxt
              then (IsOpen, IsWaiting)
              else (IsOpen, IsReview)
          Nothing -> case waiting_utc task of
            Just _ -> (IsOpen, IsWaiting)
            Nothing -> case (ready_utc task, awake_utc task) of
              (Just readyUtc, Just awakeUtc) ->
                if readyUtc < nowTxt && awakeUtc < nowTxt
                  then (IsOpen, IsReady)
                  else
                    if readyUtc > nowTxt && awakeUtc < nowTxt
                      then (IsOpen, IsAwake)
                      else (IsOpen, IsAsleep)
              (Just readyUtc, Nothing) | readyUtc < nowTxt -> (IsOpen, IsReady)
              (Nothing, Just awakeUtc) | awakeUtc < nowTxt -> (IsOpen, IsAwake)
              (Nothing, Just awakeUtc) | awakeUtc > nowTxt -> (IsOpen, IsAsleep)
              _ -> (IsOpen, IsOpen)
  
  
  newtype Ulid = Ulid Text
  
  
  data Task = Task
    { ulid :: Text -- TODO: Use Ulid type
    , body :: Text
    , modified_utc :: Text
    , awake_utc :: Maybe Text
    , ready_utc :: Maybe Text
    , waiting_utc :: Maybe Text
    , review_utc :: Maybe Text
    , due_utc :: Maybe Text
    , closed_utc :: Maybe Text
    , state :: Maybe TaskState
    , group_ulid :: Maybe Text
    , repetition_duration :: Maybe Text
    , recurrence_duration :: Maybe Text
    , priority_adjustment :: Maybe Float
    , user :: Text
    , metadata :: Maybe Aeson.Value
    }
    deriving (Generic, Data, Show, Eq)
  
  
  -- For conversion from SQLite with SQLite.Simple
  instance FromRow Task where
    fromRow =
      Task
        <$> field
        <*> field
        <*> field
        <*> field
        <*> field
        <*> field
        <*> field
        <*> field
        <*> field
        <*> field
        <*> field
        <*> field
        <*> field
        <*> field
        <*> field
        <*> ( field <&> \case
                Just (Object obj) -> Just $ Object obj
                _ -> Nothing
            )
  
  
  instance ToRow Task where
    toRow task =
      [ Sql.ToField.toField task.ulid
      , Sql.ToField.toField task.body
      , Sql.ToField.toField task.modified_utc
      , Sql.ToField.toField task.awake_utc
      , Sql.ToField.toField task.ready_utc
      , Sql.ToField.toField task.waiting_utc
      , Sql.ToField.toField task.review_utc
      , Sql.ToField.toField task.due_utc
      , Sql.ToField.toField task.closed_utc
      , Sql.ToField.toField task.state
      , Sql.ToField.toField task.group_ulid
      , Sql.ToField.toField task.repetition_duration
      , Sql.ToField.toField task.recurrence_duration
      , Sql.ToField.toField task.priority_adjustment
      , Sql.ToField.toField task.user
      , case task.metadata of
          Nothing -> SQLNull
          Just val -> SQLText $ val & (Aeson.encode >>> BSL.toStrict >>> decodeUtf8)
      ]
  
  
  instance Hashable Task
  
  
  instance Sql.FromField.FromField Value where
    fromField aField@(Field (SQLText txt) _) =
      case eitherDecodeStrictText txt of
        Left error -> returnError ConversionFailed aField error
        Right value -> Ok value
    fromField f = returnError ConversionFailed f "expecting SQLText column type"
  
  
  -- For conversion to JSON
  instance ToJSON Task
  
  
  instance Pretty Task where
    pretty =
      pretty
        . T.dropEnd 1 -- Drop trailing newline to maybe add it later
        . decodeUtf8
        . Yaml.encode
  
  
  instance Arbitrary Task where
    arbitrary = genericArbitraryU
  
  
  emptyTask :: Task
  emptyTask =
    Task
      { ulid = ""
      , body = ""
      , modified_utc = ""
      , awake_utc = Nothing
      , ready_utc = Nothing
      , waiting_utc = Nothing
      , review_utc = Nothing
      , due_utc = Nothing
      , closed_utc = Nothing
      , state = Nothing
      , group_ulid = Nothing
      , repetition_duration = Nothing
      , recurrence_duration = Nothing
      , priority_adjustment = Nothing
      , user = ""
      , metadata = Nothing
      }
  
  
  setMetadataField :: Text -> Value -> Task -> Task
  setMetadataField fieldNameText value task =
    task
      { metadata =
          case metadata task of
            Just (Object obj) ->
              Just $ Object $ KeyMap.insert (Key.fromText fieldNameText) value obj
            Nothing ->
              Just $ Object $ fromList [(Key.fromText fieldNameText, value)]
            _ -> metadata task
      }
  
  
  {-| Convert a task to a Markdown string with YAML frontmatter that can be edited
  | and then converted back to a task.
  | Tags and notes are commented out, so they are not accidentally added again.
  -}
  taskToEditableMarkdown :: Connection -> Task -> P.IO P.ByteString
  taskToEditableMarkdown conn task = do
    (tags :: [[P.Text]]) <-
      if T.null task.ulid
        then pure []
        else
          query
            conn
            [sql|
              SELECT tag
              FROM task_to_tag
              WHERE task_ulid == ?
            |]
            (Only task.ulid)
  
    (notes :: [[P.Text]]) <-
      if T.null task.ulid
        then pure []
        else
          query
            conn
            [sql|
              SELECT note
              FROM task_to_note
              WHERE task_ulid == ?
            |]
            (Only task.ulid)
  
    let
      indentNoteContent noteContent =
        noteContent
          & T.strip
          & T.lines
          <&> T.stripEnd
          & T.intercalate "\n#     "
  
      taskWithEmptyBody = task{body = ""}
      frontmatterYaml =
        ( taskWithEmptyBody
            & Yaml.encode
            & P.decodeUtf8
            & T.replace "\nbody: ''\n" "\n"
        )
          <> "\n# | Existing tags and notes can't be edited here, \
             \but new ones can be added\n\n"
          <> (("# tags: " :: Text) <> P.show (P.concat tags) <> "\n")
          <> "tags: []\n"
          <> ( ("\n# notes:\n" :: Text)
                <> ( notes
                      & P.concat
                      <&> (\note -> "# - " <> indentNoteContent note)
                      & T.unlines
                   )
             )
          <> "notes: []\n"
  
    pure $
      ("---\n" <> frontmatterYaml <> "...\n\n" <> body task)
        & P.encodeUtf8
  