{-# LANGUAGE OverloadedStrings, FlexibleInstances, ScopedTypeVariables #-}
module Network.Shopify.Products (
    Product(..), ProductWithMeta(..)
  , ProductVariant(..), VariantWithMeta(..), ProductImage(..)
  , InventoryPolicy(..), InventoryManagement(..)
  , queryProduct, queryProductMetaFields
  , queryProducts, ProductQuery(..)
  , createProduct, updateProduct, deleteProduct
  , updateStock
  ) where

import Data.Int
import Data.Fixed
import Data.List
import Data.Maybe
import Data.Time.Clock
import Control.Monad
import Control.Applicative
import Control.Monad.Trans
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Aeson ((.:), (.:?), (.=))
import qualified Data.Aeson as JS
import qualified Data.Aeson.Types as JS
import qualified Data.Aeson.Encode.Pretty as JS
import qualified Data.Set as Set
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Lazy.Char8 as BSLC8
import qualified Data.ByteString.Base64 as B64
import Network.HTTP.Types (renderQuery)
import Network.HTTP.Types.QueryLike (toQueryValue)
import qualified Network.HTTP.Conduit as HTTP
import qualified Control.Exception as E
import qualified Data.Map as Map
import Safe

import Network.Shopify.Types
import Network.Shopify.Metafield
import Network.Shopify.Connection

-- http://wiki.shopify.com/Product_(API)

data Positioned a =
    Positioned Int a

position :: [a] -> [Positioned a]
position = zipWith Positioned [1..]

unposition :: [Positioned a] -> [a]
unposition = map positionedItem . sortBy positionedCmp

positionedCmp :: Positioned a -> Positioned a -> Ordering
positionedCmp (Positioned i1 _) (Positioned i2 _) = compare i1 i2

positionedItem :: Positioned a -> a
positionedItem (Positioned _ a) = a

instance JS.FromJSON a => JS.FromJSON (Positioned a) where
  parseJSON (JS.Object v) = Positioned <$>
                            v .: "position" <*>
                            JS.parseJSON (JS.Object v)
  parseJSON _ = fail "Positioned not an object"

instance JsonExtending a => JS.ToJSON (Positioned a) where
  toJSON (Positioned p a) =
    JS.object $ (jsonExtender a) ++ ["position" .= p]

type Title = T.Text
type ProductType = T.Text
type Vendor = T.Text

deleteProduct :: ProductWithMeta -> Shopify ()
deleteProduct (PWM meta _ _) = do
  (_::JS.Value) <- shopifyDelete ("/admin/products/"++show (metaId meta)++".json")
  return ()

createProduct :: Product ProductVariant -> Shopify ProductWithMeta
createProduct pb = do
  pw <- shopifySet "/admin/products.json" False (JS.object ["product" .= pb])
  case Map.lookup ("product"::T.Text) pw of
    Just p -> return p
    Nothing -> error "product not pressent"

updateStock :: ShopifyID -> Int -> Shopify ()
updateStock vid stock = do
  (_::JS.Value) <- shopifySet ("/admin/variants/"++show vid++".json") True (
    JS.object [("variant", JS.object
                           [ ("id", JS.toJSON vid)
                           , ("inventory_quantity", JS.toJSON stock) ])])
  return ()

updateProduct :: ProductWithMeta -> Product ProductVariant -> Shopify ProductWithMeta
updateProduct (PWM meta pubtime old) new = do
  let variantMetas = map (\(VWM vmeta prod (ProductVariant {pvSku=sku})) -> (sku, (vmeta, prod))) . pVariants $ old
  let updateVariants = map (\(v@ProductVariant {pvSku=sku}) ->
                             (VWMM (fmap fst $ lookup sku variantMetas) (fmap snd $ lookup sku variantMetas) v)) .
                       pVariants $ new
  let updateRequest = PMMV meta pubtime (new { pVariants = updateVariants
                                             , pImages = [] })
  liftIO $ print updateRequest
  pw <- shopifySet ("/admin/products/"++show (metaId meta)++".json") True (JS.object [("product", JS.toJSON updateRequest)])
  p <- case Map.lookup ("product"::T.Text) pw of
    Just p' -> return p'
    Nothing -> error "product not pressent"
  forM_ (pImages old) $ \i -> do
    (_::JS.Value) <- shopifyDelete ("/admin/products/"++show (metaId meta)++"/images/"++show (metaId $ piMeta i)++".json")
    return ()
  forM_ (pImages new) $ \i -> do
    shopifySet ("/admin/products/"++show (metaId meta)++"/images.json") False (JS.object [("image", JS.toJSON i)])::Shopify JS.Value
  return p

data ProductQuery =
    PQCollection CollectionID
  | PQCreatedBefore UTCTime
  | PQCreatedAfter UTCTime
  | PQHandle T.Text
  | PQType ProductType
  | PQPublishedBefore UTCTime
  | PQPublishedAfter UTCTime
  | PQPublished Bool
  | PQVendor Vendor
  | PQUpdatedBefore UTCTime
  | PQUpdatedAfter UTCTime
  | PQIdGreaterThen ProductID
  deriving (Show)

encodeProductQuery :: ProductQuery -> (BS.ByteString, Maybe BS.ByteString)
encodeProductQuery (PQCollection cid) = ("collection_id", toQueryValue $ show cid)
encodeProductQuery (PQCreatedBefore t) = ("created_at_max", dateToQuery t)
encodeProductQuery (PQCreatedAfter t) = ("created_at_min", dateToQuery t)
encodeProductQuery (PQHandle txt) = ("handle", toQueryValue txt)
encodeProductQuery (PQType txt) = ("product_type", toQueryValue txt)
encodeProductQuery (PQPublishedBefore t) = ("published_at_max", dateToQuery t)
encodeProductQuery (PQPublishedAfter t) = ("published_at_min", dateToQuery t)
encodeProductQuery (PQPublished p) = ("published_status"
                                     ,toQueryValue $
                                      if p
                                      then "published"::String
                                      else "unpublished")
encodeProductQuery (PQVendor txt) = ("vendor", toQueryValue txt)
encodeProductQuery (PQUpdatedBefore t) = ("updated_at_max", dateToQuery t)
encodeProductQuery (PQUpdatedAfter t) = ("updated_at_min", dateToQuery t)
encodeProductQuery (PQIdGreaterThen pid) = ("since_id", toQueryValue $ show pid)

queryProductMetaFields :: ProductID -> Shopify MetaFields
queryProductMetaFields pid = do
  pw <- shopifyGet ("/admin/products/"++show pid++"/metafields.json") (const "") ()
  case Map.lookup ("metafields"::T.Text) pw of
    Just mf -> return mf
    Nothing -> error "product not pressent"

queryProduct :: ProductID -> Shopify ProductWithMeta
queryProduct pid = do
    pw <- shopifyGet ("/admin/products/"++show pid++".json") (const "") ()
    case Map.lookup ("product"::T.Text) pw of
      Just p -> return p
      Nothing -> error "product not pressent"

queryProducts :: [ProductQuery] -> Shopify [ProductWithMeta]
queryProducts q =
    getBlock 1 []
  where
    baseQuery = ("limit", Just "250"):map encodeProductQuery q
    genQuery i qry= renderQuery False (("page", toQueryValue (show i)):qry)
    getBlock :: Int -> [ProductWithMeta] -> Shopify [ProductWithMeta] 
    getBlock i ops = do
      psw <- shopifyGet "/admin/products.json" (genQuery i) baseQuery
      ps <- case Map.lookup ("products"::T.Text) psw of
        Just ps -> return ps
        Nothing -> error "products not pressent"
      if length ps < 250
        then return (ps ++ ops)
        else getBlock (i+1) (ps ++ ops)

data Product a =
  Product {
      pTitle :: Title    
    , pNameTag :: Maybe T.Text
    , pType :: ProductType
    , pHtml :: T.Text
    , pVendor :: Vendor
    , pTags :: Set.Set T.Text
    , pVariants :: [a]
    , pImages :: [ProductImage]
    , pOptions :: [T.Text]
    , pMetaFields :: MetaFields
    }
  deriving (Show)

data ProductWithMeta =
  PWM { pwmMeta :: ShopifyMeta, pwmPublished :: Maybe UTCTime, pwmProduct :: Product VariantWithMeta }
  deriving (Show)

data ProductMaybeMetaVariant =
  PMMV { pmmvMeta :: ShopifyMeta, pmmvPublished :: Maybe UTCTime, pmmvProduct :: Product VariantWithMaybeMeta }
  deriving (Show)

instance JS.ToJSON ProductMaybeMetaVariant where
  toJSON (PMMV meta pub p) = JS.object $ (jsonExtender meta) ++
                             ["published_at" .= (fmap ShopifyDate pub)] ++
                             (jsonExtender p)

instance JS.ToJSON (Product ProductVariant) where
  toJSON = JS.object . jsonExtender

instance JS.FromJSON ProductWithMeta where
  parseJSON (o@(JS.Object v)) = PWM <$>
                            JS.parseJSON o <*>
                            (v .:? "published_at" >>= (return . fmap actualTime)) <*>
                            JS.parseJSON o
  parseJSON _          = fail "ProductWithMeta not an object"

instance JS.FromJSON a => JS.FromJSON (Product a) where
  parseJSON (JS.Object v) = Product <$>
                            v .: "title" <*>
                            v .:? "handle" <*>
                            v .: "product_type" <*>
                            ((v .:? "body_html") >>= (return . fromMaybe "")) <*>
                            v .: "vendor" <*>
                            ((v .: "tags") >>= (return . Set.fromList . T.splitOn ", ")) <*>
                            ((v .: "variants") >>= (return . unposition)) <*>
                            (((v .:? "images") >>= (return . maybe [] unposition)) <|> pure []) <*>
                            ((v .:? "options") >>= (return . maybe [] (map (\(ProductOption t) -> t)))) <*>
                            pure emptyMeta
  parseJSON _          = fail "Product not an object"

instance JsonExtending a => JsonExtending (Product a) where
 jsonExtender (p@Product {}) =
    ["body_html" .= pHtml p
    ,"handle" .= pNameTag p
    ,"title" .= pTitle p
    ,"product_type" .= pType p
    ,"vendor" .= pVendor p
    ,"tags" .= (T.intercalate ", " . Set.toList . pTags) p
    ,"variants" .= position (pVariants p)
    ,"images" .= position (pImages p)
    ,"metafields" .= pMetaFields p
    ] ++ if null . pOptions $ p 
         then []
         else ["options" .= (map ProductOption $ pOptions p)]

data ProductOption = ProductOption T.Text

instance JS.FromJSON ProductOption where
  parseJSON (JS.Object v) = ProductOption <$> v .: "name"
  parseJSON _             = fail "ProductOption not an object"

instance JS.ToJSON ProductOption where
  toJSON (ProductOption t) = JS.object ["name" .= t]

{-
--  "created_at": "2012-07-19T15:42:24-04:00",
--  "id": 850703190,
  "position": 1,
--  "product_id": 632910392,
--  "updated_at": "2012-07-19T15:42:24-04:00",
--  "src": "http://static.shopify.com/s/files/1/0006/9093/3842/products/ipod-nano.png?0"
-}

data ProductImage =
    ProductImageRemote {
        piMeta :: ShopifyMeta
      , piProductID :: ProductID
      , piSrc :: T.Text
      }
  | ProductImageLocal {
        piData :: BS.ByteString
      , piFilename :: T.Text
      }
  deriving (Show)

instance JS.FromJSON ProductImage where
  -- The only sort of image that can be sent to us is the remote type.
  parseJSON (o@(JS.Object v)) = ProductImageRemote <$>
                            JS.parseJSON o <*>
                            v .: "product_id" <*>
                            v .: "src"
  parseJSON _          = fail "ProductImage not an object"

instance JS.ToJSON ProductImage where
  toJSON = JS.object . jsonExtender

instance JsonExtending ProductImage where
  jsonExtender (ProductImageRemote m pid src) =
    jsonExtender m ++ [
     "product_id" .= pid
    ,"src" .= src
    ]
  jsonExtender (ProductImageLocal d fn) = [("attachment" .= (TE.decodeUtf8 . B64.encode $ d)), ("filename" .= fn)]

{-
  "compare_at_price": null,
--  "created_at": "2012-07-19T15:42:24-04:00",
  "fulfillment_service": "manual",
--  "grams": 200,
--  "id": 808950810,
--  "inventory_management": "shopify",
--  "inventory_policy": "continue",
--  "option1": "Pink",
--  "option2": null,
--  "option3": null,
--  "position": 1,
--  "price": "199.00",
--  "product_id": 632910392,
--  "requires_shipping": true,
--  "sku": "IPOD2008PINK",
--  "taxable": true,
--  "title": "Pink",
--  "updated_at": "2012-07-19T15:42:24-04:00",
--  "inventory_quantity": 10
-}
data ProductVariant =
  ProductVariant
    { pvSku :: Sku
    , pvTitle :: T.Text
    , pvPrice :: Centi
    , pvGrams :: Int
    , pvInventory :: Int
    , pvInventoryManagement :: InventoryManagement
    , pvInventoryPolicy :: InventoryPolicy
    , pvTaxable :: Bool
    , pvShips :: Bool
    , pvOption1 :: Maybe T.Text
    , pvOption2 :: Maybe T.Text
    , pvOption3 :: Maybe T.Text
    }
  deriving (Show)

data VariantWithMeta =
  VWM { variantMeta :: ShopifyMeta, variantProductID :: ProductID,  variantVariant :: ProductVariant }
  deriving (Show)

data VariantWithMaybeMeta =
  VWMM { vwmmMeta :: (Maybe ShopifyMeta), vwmmProduct :: (Maybe ProductID), vwmmVariant :: ProductVariant }
  deriving (Show)

instance JsonExtending VariantWithMaybeMeta where
  jsonExtender (VWMM mm mp p) = (fromMaybe [] $ fmap jsonExtender mm) ++
                                (fromMaybe [] $ fmap (\pid -> ["product_id" .= pid]) mp) ++
                                (jsonExtender p)

instance JS.FromJSON VariantWithMeta where
  parseJSON (o@(JS.Object v)) = VWM <$>
                                JS.parseJSON o <*>
                                (v .: "product_id") <*>
                                JS.parseJSON o
  parseJSON _          = fail "VariantWithMeta not an object"

instance JS.FromJSON ProductVariant where
  parseJSON (JS.Object v) = ProductVariant <$>
                            v .: "sku" <*>
                            v .: "title" <*>
                            ((v .: "price"::JS.Parser String) >>=
                            (\s -> case readMay s of
                                Just c -> pure c
                                Nothing -> fail "Couldn't read price")) <*>
                            v .: "grams" <*>
                            v .: "inventory_quantity" <*>
                            ((v .: "inventory_management") >>= (return . fromMaybe InvManagedShopify)) <*>
                            v .: "inventory_policy" <*>
                            v .: "taxable" <*>
                            v .: "requires_shipping" <*>
                            v .:? "option1" <*>
                            v .:? "option2" <*>
                            v .:? "option3"
  parseJSON _          = fail "ProductVariant not an object"

instance JsonExtending ProductVariant where
    jsonExtender (pv@ProductVariant {}) =
        ["sku" .= pvSku pv
        ,"title" .= pvTitle pv
        ,"price" .= (show . pvPrice $ pv)
        ,"grams" .= pvGrams pv
        ,"inventory_quantity" .= pvInventory pv
        ,"inventory_management" .= pvInventoryManagement pv
        ,"inventory_policy" .= pvInventoryPolicy pv
        ,"taxable" .= pvTaxable pv
        ,"requires_shipping" .= pvShips pv
        ] ++ options
      where
        options = option 1 pvOption1 ++ option 2 pvOption2 ++ option 3 pvOption3
        option :: Int -> (ProductVariant -> Maybe T.Text) -> [JS.Pair]
        option i f = maybeToList $ fmap ((T.pack $ "option"++show i) .= ) (f pv)

data InventoryPolicy =
    InvPolicyContinue
  | InvPolicyDeny
  deriving (Show)

instance JS.FromJSON InventoryPolicy where
  parseJSON (JS.String "continue") = return InvPolicyContinue
  parseJSON (JS.String "deny") = return InvPolicyDeny
  parseJSON _          = fail "InventoryPolocy unknown"

instance JS.ToJSON InventoryPolicy where
  toJSON InvPolicyContinue = JS.String "continue"
  toJSON InvPolicyDeny = JS.String "deny"

data InventoryManagement =
    InvManagedShopify
  | InvManagedShipwire
  | InvManagedAmazon
  | InvManagedWebgistix
  deriving (Show)

instance JS.FromJSON InventoryManagement where
  parseJSON (JS.String "shopify") = return InvManagedShopify
  parseJSON (JS.String "shipwire") = return InvManagedShipwire
  parseJSON (JS.String "amazon_marketplace_web") = return InvManagedAmazon
  parseJSON (JS.String "webgistix") = return InvManagedWebgistix
  parseJSON _          = fail "InventoryManagement unknown"

instance JS.ToJSON InventoryManagement where
  toJSON InvManagedShopify = JS.String "shopify"
  toJSON InvManagedShipwire = JS.String "shipwire"
  toJSON InvManagedAmazon = JS.String "amazon_marketplace_web"
  toJSON InvManagedWebgistix = JS.String "webgistix"