{-# LANGUAGE TypeFamilies, OverloadedStrings, FlexibleInstances,
             UndecidableInstances, GeneralizedNewtypeDeriving #-}
module Network.PayPal.Types (
        -- * Types
        Security(..),
        Credentials(..),
        Status(..),
        -- * Classes
        ToText(..),
        FromText(..),
        ToVariables(..),
        FromVariables(..),
        PayPalRequest(decodeResponse, type PayPalResponse),
        -- * Helpers
        decodeResponseChecking,
        toTextTime,
        fromTextTime
    ) where

import Control.Applicative
import qualified Data.ByteString.Char8 as C
import Data.Map (Map)
import qualified Data.Map as M
import Data.Monoid
import Data.Ratio
import Data.Time.Calendar (Day(..))
import Data.Time.Clock
import Data.Time.Format
import Data.Time.LocalTime (TimeOfDay(..))
import System.Locale (defaultTimeLocale)
import Numeric


-- | Security.  Signature only at present:  Certificate security is not yet supported.
data Security = Signature C.ByteString

data Credentials = Credentials {
        crUsername :: C.ByteString,
        crPassword :: C.ByteString,
        crSecurity :: Security,
        crVersion  :: C.ByteString   -- ^ e.g. "56.0"
    }

-- | Check for errors, then delegate to decodeResponse if there aren't any.
decodeResponseChecking :: PayPalRequest req =>
                          [(C.ByteString, C.ByteString)]
                       -> Status (PayPalResponse req)
decodeResponseChecking pairs =
    case "ACK" `M.lookup` m of
        Just "Success" -> decodeResponse m
        Just "Failure" -> case messages 0 of
            []   -> noParse
            msgs -> Failure msgs
        _         -> noParse
  where
    m = M.fromList pairs
    noParse = ParseFailure (M.toList m) $ "malformed error message"
    messages i = case (`M.lookup` m) . (`mappend` si) <$>
                      ["L_ERRORCODE", "L_SHORTMESSAGE", "L_LONGMESSAGE", "L_SEVERITYCODE"] of
        [Just err, Just short, Just long, Just severity] ->
            case reads (C.unpack err) of
                [(errNo, "")] -> Message errNo short long severity : messages (i+1)
                _             -> []
        _ -> []
      where
        si = C.pack (show i)

data Status res = Success res
                | Failure [Message]
                | ParseFailure [(C.ByteString, C.ByteString)] String
    deriving Show

instance Functor Status where
    f `fmap` Success res = Success (f res)
    f `fmap` Failure msgs = Failure msgs
    f `fmap` ParseFailure pairs descr = ParseFailure pairs descr

-- | ErrorCode ShortMessage LongMessage SeverityCode
data Message = Message Int C.ByteString C.ByteString C.ByteString
    deriving Show

class ToText a where
    toText :: a -> C.ByteString

class FromText a where
    fromText :: C.ByteString -> Maybe a

class ToVariables a where
    toVariables :: a -> [(C.ByteString, C.ByteString)]

class FromVariables a where
    fromVariables :: Map C.ByteString C.ByteString -> Either String a

class ToVariables req => PayPalRequest req where
    data PayPalResponse req :: *
    decodeResponse :: Map C.ByteString C.ByteString -> Status (PayPalResponse req)

instance ToText Double where
    toText dbl = C.pack $ showFFloat Nothing dbl ""

instance FromText Double where
    fromText txt = case reads (C.unpack txt) of
        [(amt, "")] -> Just amt
        _ -> Nothing

instance ToText Int where
    toText = C.pack . show

instance FromText Int where
    fromText txt = case reads (C.unpack txt) of
        [(amt, "")] -> Just amt
        _ -> Nothing

instance ToText (Ratio Integer) where
    toText amt = C.pack $ showFFloat (Just 2) (realToFrac amt) ""

instance FromText (Ratio Integer) where
    fromText txt = case reads (C.unpack txt) of
        [(amt, "")] -> Just $ round ((amt :: Double) * 100) % 100
        _ -> Nothing

defaultTimeFormat :: String
defaultTimeFormat = "%Y-%m-%dT%H:%M:%SZ"

toTextTime :: FormatTime t => t -> C.ByteString
toTextTime = C.pack . formatTime defaultTimeLocale defaultTimeFormat

fromTextTime :: ParseTime t => C.ByteString -> Maybe t
fromTextTime = parseTime defaultTimeLocale defaultTimeFormat . C.unpack