{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}

module Apps.Juno.Ledger (
  dirtyPickOutAccount50a
  ,runQuery
  ,convertQuery
  ,Transaction(..)
  ,SwiftAPI(..)
  ,AcctRole(..)
  ,LedgerQuery(..)
  ,QueryResult(..)
  ) where

import Data.Either ()
import Control.Lens
import Control.Applicative ((<|>))
import Data.Aeson
import GHC.Natural
import Data.Text (Text, intercalate)

import qualified Data.Text as Text
import Data.Set (Set)
import qualified Data.Set as Set
import GHC.Generics
import Data.Map.Strict (Map)
import Data.Ratio
import qualified Data.Map.Strict as Map

import Juno.Hoplite.Eval (TransactionId(..), OpId(..), OrderedOp, Cmd(..))
import Schwifty.Swift.M105.Types

data Transaction = Transaction {
   transId :: Int
  ,opId :: Int
  ,from :: Text
  ,to   :: Text
  ,amount :: Double
  } deriving (Eq, Show, Generic, ToJSON, FromJSON)

data SwiftAPI = SwiftAPI {
   ref :: Text
  ,opCode :: Text
  ,orderingAcct :: Text
  ,orderingAcctDescription :: Text
  ,beneficiaryAcct :: Text
  ,beneficiaryAcctDescription :: Text
  ,settled :: Double
  ,currency :: Text
  ,valueDate :: Text
  ,details :: Text
  } deriving (Show, Eq, Generic, ToJSON, FromJSON)

data AcctRole = Sender | Receiver | Both deriving (Show, Eq, Generic, ToJSON, FromJSON)

data LedgerQuery = BySwiftId Integer
                 | ByAcctName AcctRole Text
                 | And [LedgerQuery]
                 -- | Or [LedgerQuery] -- If we need this, we'll add it
                 deriving (Show, Eq, Generic, ToJSON, FromJSON)

data QueryResult = QueryResult {
   swifts :: Map String SwiftAPI
  ,trans :: [Transaction]
  ,inputs :: Map String Text
  } deriving (Show, Eq, Generic, ToJSON)

-- these are here solely for convenience
type HopperLog = ([(TransactionId, [OrderedOp])], Map TransactionId SWIFT,Map TransactionId Text)
type TransLog = [(TransactionId, [OrderedOp])]
--type SwiftLog = Map TransactionId SWIFT

runQuery :: LedgerQuery -> HopperLog -> QueryResult
runQuery l hl = convertQuery $ execQuery l hl

execQuery :: LedgerQuery -> HopperLog -> HopperLog
execQuery (BySwiftId i) lss = filterById (fromInteger i) lss
execQuery (ByAcctName r i) lss = filterByAcct r i lss
execQuery (And []) _ = ([],Map.empty,mempty) -- if there's nothing to query, return nothing... techincally an error
execQuery (And [x]) lss = execQuery x lss
execQuery (And (x:xs)) lss = execQuery (And xs) (execQuery x lss)

filterById :: Natural -> HopperLog -> HopperLog
filterById i (l, ss, ts) = (l', ss', ts')
  where
    l' = filter (\(TransactionId i', _) -> i' == i) l
    ss' = Map.filterWithKey (\k _ -> k == TransactionId i) ss
    ts' = Map.filterWithKey (\k _ -> k == TransactionId i) ts

filterByAcct :: AcctRole -> Text -> HopperLog -> HopperLog
filterByAcct r a (l, ss, ts) = (l', ss', ts')
  where
    l' = filter (acctInvolved r a . snd) l
    ss' = Map.filterWithKey (\k _ -> Set.member k (associatedSwiftIds l')) ss
    ts' = Map.filterWithKey (\k _ -> Set.member k (associatedSwiftIds l')) ts

acctInTrans :: AcctRole -> Text -> OrderedOp -> Bool
acctInTrans Sender a (_, Cmd to' _ _ _) = to' == a
acctInTrans Receiver a (_, Cmd _ from' _ _) = from' == a
acctInTrans Both a (_, Cmd to' from' _ _) = from' == a || to' == a

acctInvolved :: AcctRole -> Text -> [OrderedOp] -> Bool
acctInvolved r a = any (acctInTrans r a)

associatedSwiftIds :: TransLog -> Set TransactionId
associatedSwiftIds = Set.fromList . fmap fst

convertQuery :: HopperLog -> QueryResult
convertQuery (l, ss, ts) = QueryResult ss' l' ts'
  where
    ss' = Map.map convertSWIFT $ Map.mapKeys (\(TransactionId i) -> show i) ss
    l' = convertTrans l
    ts' = Map.mapKeys (\(TransactionId i) -> show i) ts


convertSWIFT :: SWIFT -> SwiftAPI
convertSWIFT m = SwiftAPI
  (m ^. sCode20 . unSendersRef) -- ref :: Text
  (Text.pack $ show $ m ^. sCode23B) -- opCode :: Text
  (dirtyPickOutAccount50a m) -- orderingAcct :: Text
  (orderingAcctFreetext m) -- orderingAcctDescription :: Text
  (m ^. sCode59a . bcAccount) -- beneficiaryAcct :: Text
  (beneficiaryAcctFreetext m) -- beneficiaryAcctDescription :: Text
  (convertAmount m) -- settled :: Double
  (m ^. sCode32A . vcsCurrency) -- currency :: Text
  (Text.pack $ m ^. sCode32A . vcsValueDate . unTime ) -- valueDate :: Text
  (Text.pack $ show $ m ^. sCode71A) -- details :: Text

convertAmount :: SWIFT -> Double
convertAmount m = fromRational $ wholeDollars + cents
 where
   wholeDollars :: Rational
   wholeDollars = fromIntegral $ m ^. sCode32A . vcsSettlementAmount . vWhole
   stupidCents :: Ratio Int
   stupidCents =  m ^. sCode32A . vcsSettlementAmount . vPart
   cents :: Rational
   cents = (fromIntegral $ numerator stupidCents) % (fromIntegral $ denominator stupidCents)

dirtyPickOutAccount50a :: SWIFT -> Text
dirtyPickOutAccount50a s = case s ^? (sCode50a . ocA_Account . unAccount) of
  Just v -> v
  Nothing -> case s ^? (sCode50a . ocK_Account . unAccount) of
    Just v -> v
    Nothing -> case s ^? (sCode50a . ocF_Account . unF50F_Account . unAccount) of
      Just v -> v
      Nothing -> case s ^? (sCode50a . ocF_Account . unF50F_PartyId . piIdentifier) of
        Just v -> v
        Nothing -> error "Invariant Error: invalid swift detected, no Code50a account"

orderingAcctFreetext :: SWIFT -> Text
orderingAcctFreetext s = maybe "" (intercalate "\n") $
  (s ^? sCode50a . ocA_remainder . _Just)   <|>
    (s ^? sCode50a . ocF_remainder . _Just) <|>
    (s ^? sCode50a . ocK_remainder . _Just)

beneficiaryAcctFreetext :: SWIFT -> Text
beneficiaryAcctFreetext s = s ^. sCode59a . bcDetails

convertTrans :: TransLog -> [Transaction]
convertTrans t = concat $ convertEntry <$> t
  where
    convertOp :: TransactionId -> OrderedOp -> Transaction
    convertOp (TransactionId tId) (OpId oId, Cmd from' to' amt' _) =
      Transaction (fromIntegral tId) (fromIntegral oId) from' to' (fromRational amt')
    convertEntry :: (TransactionId, [OrderedOp]) -> [Transaction]
    convertEntry (tId, oOps) = convertOp tId <$> oOps
