module Issue.Filter
  ( Filter,
    filterArg,
    applyFilters,
  )
where

import Control.Applicative (liftA2, (<|>))
import Data.Attoparsec.Text qualified as A
import Data.Text (Text)
import Data.Text qualified as T
import Data.Time.Calendar (Day)
import Issue (Issue (..))
import Issue.Tag (tagKey, tagValue)
import Options.Applicative qualified as O
import Text.Read (readMaybe)

-- TODO Revise filter negation
--
-- Currently the following syntax in valid:
--
-- ```
-- --filter !@t                      (*)
-- --filter !@t v
-- --filter !@t <v
-- ```
--
-- It does not do what one might expect.
--
-- Currently the following syntax is invalid[1]:
--
-- ```
-- --filter @t !v
-- --filter @t !<v
-- ```
--
-- I will have to think about what types of negation to support and with what
-- semantics.
--
-- I am leaning towards only being able to use negation on the tag when no
-- operators are used, ie. only allowing (*). Thoughts?
--
-- [1] Not in the sense that it is rejected, but in the sense that the negation
-- is not parsed. It is just the literal value `!<v`.
data Filter = Filter Mode SimpleFilter deriving (Show)

data Mode = Include | Exclude deriving (Show)

data SimpleFilter
  = ByTag Text (Maybe (Op, Text))
  deriving (Show)

filterParser :: A.Parser Filter
filterParser = Filter <$> modeParser <*> simpleFilterParser
  where
    modeParser :: A.Parser Mode
    modeParser = (const Exclude <$> A.string "!") <|> (pure Include)

    simpleFilterParser :: A.Parser SimpleFilter
    simpleFilterParser =
      A.choice
        [ byTagParser
        ]

    byTagParser :: A.Parser SimpleFilter
    byTagParser =
      ByTag
        <$> (A.string "@" *> A.takeWhile1 (/= ' ') <* A.skipSpace)
        <*> ((Just <$> opParser (A.takeWhile1 (/= '\n'))) <|> pure Nothing)

    opParser :: A.Parser a -> A.Parser (Op, a)
    opParser p =
      (,)
        <$> ( A.choice
                [ A.try (pure Ge <* A.string ">="),
                  A.try (pure Le <* A.string "<="),
                  pure Gt <* A.string ">",
                  pure Lt <* A.string "<",
                  pure Eq
                ]
            )
        <*> p

data Op
  = Eq
  | Ge
  | Gt
  | Le
  | Lt
  deriving (Show)

filterArg :: O.Parser [Filter]
filterArg =
  O.many
    ( O.option
        (O.eitherReader (A.parseOnly filterParser . T.pack))
        ( O.long "filter"
            <> O.short 'f'
            <> O.metavar "FILTER"
            <> O.help "Filters selected issues. Examples: @assigned, !@assigned joe"
        )
    )

applyFilters :: [Filter] -> ([Issue] -> [Issue])
applyFilters fs = filter (filtersPredicate fs)

filtersPredicate :: [Filter] -> (Issue -> Bool)
filtersPredicate [] = \_ -> True
filtersPredicate fs = foldr1 (liftA2 (&&)) (map filterPredicate fs)

filterPredicate :: Filter -> (Issue -> Bool)
filterPredicate (Filter m sf) = modePredicate m (simpleFilterPredicate sf)

modePredicate :: Mode -> (Issue -> Bool) -> (Issue -> Bool)
modePredicate Include p = p
modePredicate Exclude p = not . p

simpleFilterPredicate :: SimpleFilter -> (Issue -> Bool)
simpleFilterPredicate (ByTag k v) i = any ((&&) <$> matchKey <*> matchValue) (i.tags ++ i.internalTags)
  where
    matchKey = (==) k . tagKey
    matchValue t =
      case (v, tagValue t) of
        (Just (o, v'), Just w') -> cast (op o) v' w'
        (Just _, Nothing) -> False
        (Nothing, _) -> True

op :: Ord a => Op -> (a -> a -> Bool)
op (Eq) = flip (==)
op (Ge) = flip (>=)
op (Gt) = flip (>)
op (Le) = flip (<=)
op (Lt) = flip (<)

data Type a where
  Date :: Type Day
  Int :: Type Int
  String :: Type Text

cast :: (forall a. Ord a => a -> a -> Bool) -> (Text -> Text -> Bool)
cast eq x y
  | Just x' <- castTo Date x, Just y' <- castTo Date y = eq x' y'
  | Just _ <- castTo Date x, Nothing <- castTo Date y = False
  | Just x' <- castTo Int x, Just y' <- castTo Int y = eq x' y'
  | Just _ <- castTo Int x, Nothing <- castTo Int y = False
  | otherwise = eq x y

castTo :: Type a -> Text -> Maybe a
castTo Date = readMaybe . T.unpack
castTo Int = readMaybe . T.unpack
castTo String = Just