{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Notmuch where

import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Lazy.Char8 as LBS8
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding as LT
import qualified Network.Mail.Mime as M
import Data.Aeson.Extends
import Data.Either.Combinators (mapRight)
import Data.Functor ((<&>))
import Data.Tree
import Notmuch.Class
import Notmuch.Message
import Notmuch.SearchResult
import Much.ParseMail (readMail)
import System.Exit
import System.Process.ByteString.Lazy (readProcessWithExitCode)
import Much.TagUtils


notmuch :: [String] -> IO LBS.ByteString
notmuch args = do
    (_exitCode, out, _err) <- notmuch' args
    return out


notmuch' :: [String] -> IO (ExitCode, LBS.ByteString, LBS.ByteString)
notmuch' args =
    readProcessWithExitCode "notmuch" args ""


search :: [String] -> IO (Either String [SearchResult])
search args =
    eitherDecodeLenient' <$>
        notmuch ("search" : "--format=json" : "--format-version=2" : args)


data ReplyTo = ToAll | ToSender
instance Show ReplyTo where
    show ToAll = "all"
    show ToSender = "sender"

--notmuchReply :: String -> IO (Either String [SearchResult])
notmuchReply :: ReplyTo -> String -> IO LBS.ByteString
notmuchReply replyTo term =
    notmuch
        [ "reply"
        , "--reply-to=" ++ show replyTo
        , term
        ]
 --       >>= return . eitherDecodeLenient'


notmuchShow :: String -> IO (Forest Message)
notmuchShow term = do
    c' <- notmuch [ "show", "--format=json", "--format-version=2"
                   , term ]
    -- TODO why head?
    return $ threadForest $ head $
        either error id (eitherDecodeLenient' c')


notmuchShowPartRaw :: String -> Int -> IO (Either String LBS8.ByteString)
notmuchShowPartRaw term partId = do
    (exitCode, out, err) <-
        notmuch' [ "show", "--format=raw"
                 , "--part=" <> show partId
                 , term ]
    return $ case exitCode of
        ExitSuccess -> Right out
        _ -> Left $ show exitCode <> ": " <> LBS8.unpack err

notmuchShowPart :: String -> Int -> IO (Either String MessagePart)
notmuchShowPart term partId = do
    -- TODO handle partId == 0 and partId > N
    (exitCode, out, err) <-
        notmuch' [ "show", "--format=json", "--format-version=2"
                 , "--part=" <> show partId
                 , term ]
    case exitCode of
        ExitSuccess ->
          case eitherDecodeLenient' out of
            Right mp -> do
              case partContent mp of
                ContentRaw "" contentLength ->
                  notmuchShowPartRaw term partId <&> mapRight (\raw ->
                      mp { partContent = ContentRaw raw contentLength }
                    )
                _ ->
                  return $ Right mp
            Left err2 ->
              return $ Left err2
        _ ->
          return $ Left $ show exitCode <> ": " <> LBS8.unpack err


notmuchShowMail :: String -> IO (Either String M.Mail)
notmuchShowMail term =
    notmuch' [ "show", "--format=raw", "--format-version=2", term ]
    >>= return . \case
      (ExitSuccess, out, _) ->
          case LT.decodeUtf8' out of
              Right x -> Right (readMail $ LT.toStrict x)
              Left ex -> Left $ "meh" ++ show ex
      (exitCode, _, err) ->
          Left $ "notmuch failed with exit code " ++ show exitCode ++
                 ": " ++ LBS8.unpack err


notmuchTag :: HasNotmuchId a => [TagOp] -> a -> IO ()
notmuchTag tagOps x =
    notmuch ("tag" : tagOpsToArgs tagOps ++ [notmuchId x]) >> return ()