content: {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE TupleSections #-}
  {-# LANGUAGE TypeOperators #-}
  module Routes.Admin.Products
      ( ProductAPI
      , productRoutes
      ) where
  
  import Control.Monad (forM_, unless)
  import Control.Monad.Reader (liftIO, lift)
  import Data.Aeson ((.=), (.:), (.:?), ToJSON(..), FromJSON(..), Value(Object), object, withObject)
  import Data.Csv (DefaultOrdered(..), ToNamedRecord(..), encodeDefaultOrderedByName, namedRecord)
  import Data.Maybe (mapMaybe, listToMaybe, fromMaybe)
  import Data.Text.Encoding (encodeUtf8)
  import Data.Time (UTCTime, getCurrentTime)
  import Database.Persist
      ( (==.), (=.), (<-.), Entity(..), SelectOpt(Asc), selectList, selectFirst
      , insert, insertMany_, insert_, update, get, getBy, deleteWhere, delete
      )
  import Network.HTTP.Media ((//), (/:))
  import Servant
      ( (:<|>)(..), (:>), Accept(..), AuthProtect, Delete, ReqBody, Capture, Get , MimeRender(..), Post, JSON, err404
      )
  
  import Auth (WrappedAuthToken, Cookied, withAdminCookie, validateAdminAndParameters)
  import Models
      ( EntityField(..), Product(..), ProductId, ProductVariant(..), ProductVariantId
      , SeedAttribute(..), Category(..), CategoryId, Unique(..), slugify
      , ProductToCategory(..)
      )
  import Models.Fields (InventoryPolicy(..), LotSize(..), Cents, Milligrams, Region, formatCents, toGrams)
  import Routes.CommonData
      ( AdminCategorySelect, makeAdminCategorySelects, validateCategorySelect
      , getAdditionalCategories
      )
  import Routes.Utils (activeVariantExists, makeImageFromBase64, sanitize)
  import Server (App, AppSQL, runDB, serverError)
  import Validation (Validation(validators))
  
  import qualified Data.ByteString as BS
  import qualified Data.ByteString.Lazy as LBS
  import qualified Data.Csv as CSV
  import qualified Data.Text as T
  import qualified Data.List as L
  import qualified Data.Map.Strict as M
  import qualified Database.Esqueleto.Experimental as E
  import qualified Validation as V
  
  
  type ProductAPI =
           "list" :> ProductListRoute
      :<|> "data" :> SharedProductDataRoute
      :<|> "new" :> NewProductRoute
      :<|> "edit" :> EditProductDataRoute
      :<|> "edit" :> EditProductRoute
      :<|> "export" :> ExportProductRoute
      :<|> "delete" :> DeleteProductRoute
      :<|> "restore" :> RestoreDeletedProductRoute
  
  type ProductRoutes =
           (WrappedAuthToken -> App (Cookied ProductListData))
      :<|> (WrappedAuthToken -> App (Cookied SharedProductData))
      :<|> (WrappedAuthToken -> ProductParameters -> App (Cookied ProductId))
      :<|> (WrappedAuthToken -> ProductId -> App (Cookied EditProductData))
      :<|> (WrappedAuthToken -> EditProductParameters -> App (Cookied ProductId))
      :<|> (WrappedAuthToken -> ProductId -> App (Cookied LBS.ByteString))
      :<|> (WrappedAuthToken -> ProductId -> App (Cookied ()))
      :<|> (WrappedAuthToken -> ProductId -> App (Cookied ()))
  
  productRoutes :: ProductRoutes
  productRoutes =
           productListRoute
      :<|> sharedProductDataRoute
      :<|> newProductRoute
      :<|> editProductDataRoute
      :<|> editProductRoute
      :<|> exportProductRoute
      :<|> deleteProductRoute
      :<|> restoreDeletedProductRoute
  
  
  -- LIST
  
  
  type ProductListRoute =
         AuthProtect "cookie-auth"
      :> Get '[JSON] (Cookied ProductListData)
  
  newtype ProductListData =
      ProductListData
          { pldProducts :: [ListProduct]
          } deriving (Show)
  
  instance ToJSON ProductListData where
      toJSON ProductListData {..} =
          object
              [ "products" .= pldProducts
              ]
  
  data ListProduct =
      ListProduct
          { lpId :: ProductId
          , lpName :: T.Text
          , lpBaseSku :: T.Text
          , lpCategories :: [T.Text]
          , lpIsActive :: Bool
          , lpIsDeleted :: Bool
          } deriving (Show)
  
  instance ToJSON ListProduct where
      toJSON ListProduct {..} =
          object
              [ "id" .= lpId
              , "name" .= lpName
              , "baseSKU" .= lpBaseSku
              , "categories" .= lpCategories
              , "isActive" .= lpIsActive
              , "isDeleted" .= lpIsDeleted
              ]
  
  productListRoute :: WrappedAuthToken -> App (Cookied ProductListData)
  productListRoute t = withAdminCookie t $ \_ -> runDB $ do
      categoryNameMap <- makeNameMap <$> selectList [] []
      ProductListData . map (makeProduct categoryNameMap) <$> getProducts
    where
      makeNameMap :: [Entity Category] -> M.Map CategoryId T.Text
      makeNameMap =
          foldr (\(Entity cId c) m -> M.insert cId (categoryName c) m) M.empty
      getProducts :: AppSQL [(Entity Product, E.Value Bool)]
      getProducts =
          E.select $ E.from E.table >>= \p -> do
              E.orderBy [E.asc $ p E.^. ProductBaseSku]
              return (p, activeVariantExists p )
      makeProduct :: M.Map CategoryId T.Text -> (Entity Product, E.Value Bool) -> ListProduct
      makeProduct nameMap (Entity pId prod, isActive) =
          ListProduct
              { lpId = pId
              , lpName = productName prod
              , lpBaseSku = productBaseSku prod
              , lpCategories = (: []) . fromMaybe "" $ productMainCategory prod `M.lookup` nameMap
              , lpIsActive = E.unValue isActive
              , lpIsDeleted = productDeleted prod
              }
  
  
  -- NEW / EDIT COMMON DATA
  
  
  type SharedProductDataRoute =
         AuthProtect "cookie-auth"
      :> Get '[JSON] (Cookied SharedProductData)
  
  newtype SharedProductData =
      SharedProductData
          { spdCategories :: [AdminCategorySelect]
          } deriving (Show)
  
  instance ToJSON SharedProductData where
      toJSON SharedProductData {..} =
          object [ "categories" .= spdCategories ]
  
  sharedProductDataRoute :: WrappedAuthToken -> App (Cookied SharedProductData)
  sharedProductDataRoute t = withAdminCookie t $ \_ ->
      SharedProductData <$> runDB makeAdminCategorySelects
  
  
  data ProductParameters =
      ProductParameters
          { ppName :: T.Text
          , ppSlug :: T.Text
          , ppCategories :: [CategoryId]
          , ppBaseSku :: T.Text
          , ppLongDescription :: T.Text
          , ppImageUpdates :: M.Map Int ProductImageOperation
          -- ^ Base64 Encoded image file and the image name
          , ppKeywords :: T.Text
          , ppShippingRestrictions :: [Region]
          , ppVariantData :: [VariantData]
          , ppSeedAttribute :: Maybe SeedData
          } deriving (Show)
  
  data ProductImageOperation
      = ProductImageDelete
      | ProductImageUpdate ProductImageData
      deriving (Show)
  
  instance FromJSON ProductImageOperation where
      parseJSON = withObject "ProductImageOperation" $ \v -> do
          opType <- v .: "operation"
          case opType of
              "delete" -> return ProductImageDelete
              "update" -> ProductImageUpdate <$> v .: "data"
              _ -> fail $ "Unknown operation type: " ++ T.unpack opType
  
  data ProductImageData = ProductImageData
      { pidFileName :: T.Text
      , pidBase64Data :: BS.ByteString
      } deriving (Show)
  
  instance FromJSON ProductImageData where
      parseJSON = withObject "ProductImageData" $ \v -> do
          pidFileName <- v .: "fileName"
          pidBase64Data <- encodeUtf8 <$> v .: "base64Image"
          return ProductImageData {..}
  
  instance FromJSON ProductParameters where
      parseJSON = withObject "ProductParameters" $ \v -> do
          ppName <- v .: "name"
          ppSlug <- v .: "slug"
          ppCategories <- v .: "categories"
          ppBaseSku <- v .: "baseSku"
          ppLongDescription <- v .: "longDescription"
          ppImageUpdates <- v .: "imageUpdates"
          ppKeywords <- fromMaybe "" <$> (v .:? "keywords")
          ppShippingRestrictions <- v .: "shippingRestrictions"
          ppVariantData <- v .: "variants"
          ppSeedAttribute <- v .: "seedAttributes"
          return ProductParameters {..}
  
  instance Validation ProductParameters where
      validators ProductParameters {..} = do
          slugDoesntExist <- V.doesntExist $ UniqueProductSlug ppSlug
          skuDoesntExist <- V.doesntExist $ UniqueBaseSku ppBaseSku
          categoryValidations <- validateCategorySelect True ppCategories
          return $
              [ ( ""
                , [ ("At least one Variant is required.", null ppVariantData) ]
                )
              , ( "name"
                , [ V.required ppName ]
                )
              , ( "slug"
                ,  [ V.required ppSlug
                   , ( "A Product with this Slug already exists."
                     , slugDoesntExist
                     )
                   ]
                )
              , ( "baseSku"
                , [ V.required ppBaseSku
                  , ( "A Product with this SKU already exists."
                    , skuDoesntExist
                    )
                  ]
                )
              ]
              ++ getDuplicateSuffixErrors ppVariantData
              ++ categoryValidations
  
  data VariantData =
      VariantData
          { vdSkuSuffix :: T.Text
          , vdPrice :: Cents
          , vdQuantity :: Int
          , vdLotSize :: Maybe LotSize
          , vdIsActive :: Bool
          , vdInventoryPolicy :: InventoryPolicy
          , vdId :: Maybe ProductVariantId
          -- ^ Only used in the EditProductRoute
          } deriving (Show)
  
  instance FromJSON VariantData where
      parseJSON = withObject "VariantData" $ \v -> do
          vdSkuSuffix <- v .: "skuSuffix"
          vdPrice <- v .: "price"
          vdQuantity <- v .: "quantity"
          vdLotSize <- v .: "lotSize"
          vdIsActive <- v .: "isActive"
          vdId <- v .: "id"
          vdInventoryPolicy <- v .: "inventoryPolicy"
          return VariantData {..}
  
  instance ToJSON VariantData where
      toJSON VariantData {..} =
          object
              [ "id" .= vdId
              , "skuSuffix" .= vdSkuSuffix
              , "price" .= vdPrice
              , "quantity" .= vdQuantity
              , "lotSize" .= vdLotSize
              , "isActive" .= vdIsActive
              , "inventoryPolicy" .= vdInventoryPolicy
              ]
  
  data SeedData =
      SeedData
          { sdOrganic :: Bool
          , sdHeirloom :: Bool
          , sdSmallGrower :: Bool
          , sdRegional :: Bool
          } deriving (Show)
  
  instance FromJSON SeedData where
      parseJSON = withObject "SeedData" $ \v -> do
          sdOrganic <- v .: "organic"
          sdHeirloom <- v .: "heirloom"
          sdSmallGrower <- v .: "smallGrower"
          sdRegional <- v .: "regional"
          return SeedData {..}
  
  instance ToJSON SeedData where
      toJSON SeedData {..} =
          object
              [ "organic" .= sdOrganic
              , "heirloom" .= sdHeirloom
              , "smallGrower" .= sdSmallGrower
              , "regional" .= sdRegional
              ]
  
  
  -- NEW
  
  
  type NewProductRoute =
         AuthProtect "cookie-auth"
      :> ReqBody '[JSON] ProductParameters
      :> Post '[JSON] (Cookied ProductId)
  
  newProductRoute :: WrappedAuthToken -> ProductParameters -> App (Cookied ProductId)
  newProductRoute = validateAdminAndParameters $ \_ p@ProductParameters {..} -> do
      time <- liftIO getCurrentTime
      imageFileNames <- mapM
          (\(ProductImageData fileName encodedImage) -> makeImageFromBase64 "products" fileName encodedImage)
          (mapMaybe
              (\case
                  ProductImageUpdate imageData -> Just imageData
                  _ -> Nothing
              ) (M.elems ppImageUpdates)
          )
      runDB $ do
          (prod, extraCategories) <- makeProduct p imageFileNames time
          productId <- insert prod
          insertMany_ $ map (ProductToCategory productId) extraCategories
          maybe (return ()) (insert_ . makeAttributes productId) ppSeedAttribute
          return productId
    where
      makeProduct :: ProductParameters -> [T.Text] -> UTCTime -> AppSQL (Product, [CategoryId])
      makeProduct ProductParameters {..} imageUrls time =
          case ppCategories of
              main : rest -> return
                  ( Product
                      { productName = sanitize ppName
                      , productSlug = slugify ppSlug
                      , productMainCategory = main
                      , productBaseSku = ppBaseSku
                      , productShortDescription = ""
                      , productLongDescription = sanitize ppLongDescription
                      , productImageUrls = imageUrls
                      , productKeywords = ppKeywords
                      , productShippingRestrictions = L.nub ppShippingRestrictions
                      , productCreatedAt = time
                      , productUpdatedAt = time
                      , productDeleted = False
                      }
                  , rest
                  )
              [] ->
                  lift $ V.singleError "At least one Category is required."
  
  
  -- EDIT
  
  
  type EditProductDataRoute =
         AuthProtect "cookie-auth"
      :> Capture "id" ProductId
      :> Get '[JSON] (Cookied EditProductData)
  
  data EditProductData =
      EditProductData
          { epdId :: ProductId
          , epdName :: T.Text
          , epdSlug :: T.Text
          , epdCategories :: [CategoryId]
          , epdBaseSku :: T.Text
          , epdLongDescription :: T.Text
          , epdImageUrls :: [T.Text]
          , epdKeywords :: T.Text
          , epdShippingRestrictions :: [Region]
          , epdVariantData :: [VariantData]
          , epdSeedAttribute :: Maybe SeedData
          } deriving (Show)
  
  instance ToJSON EditProductData where
      toJSON EditProductData {..} =
          object
              [ "id" .= epdId
              , "name" .= epdName
              , "slug" .= epdSlug
              , "categories" .= epdCategories
              , "baseSku" .= epdBaseSku
              , "longDescription" .= epdLongDescription
              , "imageUrls" .= epdImageUrls
              , "keywords" .= epdKeywords
              , "shippingRestrictions" .= epdShippingRestrictions
              , "variants" .= epdVariantData
              , "seedAttributes" .= epdSeedAttribute
              ]
  
  editProductDataRoute :: WrappedAuthToken -> ProductId -> App (Cookied EditProductData)
  editProductDataRoute t productId = withAdminCookie t $ \_ ->
      runDB (get productId) >>= \case
          Nothing ->
              serverError err404
          Just Product {..} -> runDB $ do
              variants <- map makeVariantData
                  <$> selectList
                      [ProductVariantProductId ==. productId]
                      [Asc ProductVariantSkuSuffix]
              seedAttr <- fmap makeAttributeData <$> getBy (UniqueAttribute productId)
              categories <- getAdditionalCategories productId
              return EditProductData
                  { epdId = productId
                  , epdName = productName
                  , epdSlug = productSlug
                  , epdCategories = productMainCategory
                      : map (productToCategoryCategoryId . entityVal) categories
                  , epdBaseSku = productBaseSku
                  , epdLongDescription = productLongDescription
                  , epdImageUrls = productImageUrls
                  , epdKeywords = productKeywords
                  , epdShippingRestrictions = productShippingRestrictions
                  , epdVariantData = variants
                  , epdSeedAttribute = seedAttr
                  }
    where
      makeVariantData :: Entity ProductVariant -> VariantData
      makeVariantData (Entity variantId ProductVariant {..}) =
          VariantData
              { vdId = Just variantId
              , vdSkuSuffix = productVariantSkuSuffix
              , vdPrice = productVariantPrice
              , vdQuantity = fromIntegral productVariantQuantity
              , vdLotSize = productVariantLotSize
              , vdIsActive = productVariantIsActive
              , vdInventoryPolicy = productVariantInventoryPolicy
              }
      makeAttributeData :: Entity SeedAttribute -> SeedData
      makeAttributeData (Entity _ SeedAttribute {..}) =
          SeedData
              { sdOrganic = seedAttributeIsOrganic
              , sdHeirloom = seedAttributeIsHeirloom
              , sdRegional = seedAttributeIsRegional
              , sdSmallGrower = seedAttributeIsSmallGrower
              }
  
  
  
  type EditProductRoute =
         AuthProtect "cookie-auth"
      :> ReqBody '[JSON] EditProductParameters
      :> Post '[JSON] (Cookied ProductId)
  
  
  data EditProductParameters =
      EditProductParameters
          { eppId :: ProductId
          , eppProduct :: ProductParameters
          }
  
  instance FromJSON EditProductParameters where
      parseJSON = withObject "EditProductParameters" $ \v -> do
          eppId <- v .: "id"
          eppProduct <- parseJSON $ Object v
          return EditProductParameters {..}
  
  instance Validation EditProductParameters where
      validators EditProductParameters {..} = do
          let ProductParameters {..} = eppProduct
          productExists <- V.exists eppId
          categoryValidations <- validateCategorySelect True ppCategories
          return $
              [ ( ""
                , [ ("Could not find this product in the database.", productExists)
                  , ("At least one Variant is required.", null ppVariantData)
                  ]
                )
              , ( "name", [ V.required ppName ] )
              , ( "slug", [ V.required ppSlug ] )
              , ( "baseSku", [ V.required ppBaseSku ])
              ]
              ++ getDuplicateSuffixErrors ppVariantData
              ++ categoryValidations
  
  
  editProductRoute :: WrappedAuthToken -> EditProductParameters -> App (Cookied ProductId)
  editProductRoute = validateAdminAndParameters $ \_ EditProductParameters {..} -> do
      let ProductParameters {..} = eppProduct
      imageUpdate <-
          if not (null ppImageUpdates) then do
              imageUrls <- fmap (fmap (\(Entity _ p) -> productImageUrls p)) $ runDB $ selectFirst [ProductId ==. eppId] []
              let existingImages = fromMaybe [] imageUrls
              imageFileNames <- updateImageList ppImageUpdates existingImages
              return [ ProductImageUrls =. imageFileNames ]
          else
              return []
      time <- liftIO getCurrentTime
      (mainCategory, extraCategories) <-
          case ppCategories of
              [] ->
                  V.singleError "At least one Category is required."
              main : rest ->
                  return (main, rest)
      runDB $ do
          update eppId $
              [ ProductName =. sanitize ppName
              , ProductSlug =. slugify ppSlug
              , ProductMainCategory =. mainCategory
              , ProductBaseSku =. ppBaseSku
              , ProductLongDescription =. sanitize ppLongDescription
              , ProductKeywords =. ppKeywords
              , ProductShippingRestrictions =. L.nub ppShippingRestrictions
              , ProductUpdatedAt =. time
              ] ++ imageUpdate
          deleteWhere [ProductToCategoryProductId ==. eppId]
          insertMany_ $ map (ProductToCategory eppId) extraCategories
          (ppSeedAttribute,) <$> selectFirst [SeedAttributeProductId ==. eppId] [] >>= \case
              (Just seedData, Nothing) ->
                  insert_ $ makeAttributes eppId seedData
              (Just SeedData {..}, Just (Entity attrId _)) ->
                  update attrId
                      [ SeedAttributeProductId =. eppId
                      , SeedAttributeIsOrganic =. sdOrganic
                      , SeedAttributeIsHeirloom =. sdHeirloom
                      , SeedAttributeIsRegional =. sdRegional
                      , SeedAttributeIsSmallGrower =. sdSmallGrower
                      ]
              (Nothing, Just (Entity attrId _)) ->
                  delete attrId
              _ ->
                  return ()
          forM_ ppVariantData $ \variant@VariantData {..} ->
              case vdId of
                  Nothing ->
                      insert_ $ makeVariant eppId variant
                  Just variantId -> do
                      update variantId
                          [ ProductVariantProductId =. eppId
                          , ProductVariantSkuSuffix =. vdSkuSuffix
                          , ProductVariantPrice =. vdPrice
                          , ProductVariantQuantity =. fromIntegral vdQuantity
                          , ProductVariantLotSize =. vdLotSize
                          , ProductVariantIsActive =. vdIsActive
                          , ProductVariantInventoryPolicy =. vdInventoryPolicy
                          ]
                      unless vdIsActive $
                          deleteWhere [CartItemProductVariantId ==. variantId]
      return eppId
      where
          updateImageList :: M.Map Int ProductImageOperation -> [T.Text] -> App [T.Text]
          updateImageList imageUpdates oldImageUrls = do
              let maxIdx = max (if null oldImageUrls then -1 else length oldImageUrls - 1)
                      (if null (M.keys imageUpdates) then -1 else maximum (M.keys imageUpdates))
              let buildList idx
                      | idx > maxIdx = return []
                      | otherwise = case M.lookup idx imageUpdates of
                          Just ProductImageDelete ->
                              buildList (idx + 1)
                          Just (ProductImageUpdate (ProductImageData fileName encodedImage)) -> do
                              img <- makeImageFromBase64 "products" fileName encodedImage
                              rest <- buildList (idx + 1)
                              return $ img : rest
                          Nothing ->
                              case drop idx oldImageUrls of
                                  (img : _) -> do
                                      rest <- buildList (idx + 1)
                                      return $ img : rest
                                  [] -> buildList (idx + 1)
              buildList 0
  
  -- EXPORT
  
  data CSV
  
  instance Accept CSV where
      contentType _ = "text" // "csv" /: ("charset", "utf-8")
  
  instance MimeRender CSV LBS.ByteString where
      mimeRender _ = id
  
  data ProductExportData = ProductExportData
      { pedSku :: T.Text
      , pedName :: T.Text
      , pedPrice :: Cents
      , pedLotSize :: Maybe LotSize
      , pedDescription :: T.Text
      , pedDiscontinued :: Bool
      , pedQOH :: Int
      , pedCategory :: T.Text
      , pedOrganic :: Bool
      , pedHeirloom :: Bool
      , pedSmallGrower :: Bool
      , pedRegional :: Bool
      }
  
  instance ToNamedRecord ProductExportData where
      toNamedRecord ProductExportData {..} =
          namedRecord
              [ "sku" CSV..= pedSku
              , "name" CSV..= pedName
              , "price" CSV..= formatCents pedPrice
              , "weight" CSV..= CSV.toField (toGrams <$> lotSizeToWeight pedLotSize)
              , "description" CSV..= pedDescription
              , "discontinued" CSV..= show pedDiscontinued
              , "qoh" CSV..= pedQOH
              , "category" CSV..= pedCategory
              , "organic" CSV..= boolSeedAttributeToField pedOrganic
              , "heirloom" CSV..= boolSeedAttributeToField pedHeirloom
              , "small grower" CSV..= boolSeedAttributeToField pedSmallGrower
              , "regional" CSV..= boolSeedAttributeToField pedRegional
              ]
          where
              boolSeedAttributeToField :: Bool -> String
              boolSeedAttributeToField = show
  
              lotSizeToWeight :: Maybe LotSize -> Maybe Milligrams
              lotSizeToWeight = \case
                  Just (Mass m) -> Just m
                  Just (Bulbs _) -> Nothing
                  Just (Slips _) -> Nothing
                  Just (Plugs _) -> Nothing
                  Just (CustomLotSize _) -> Nothing
                  Nothing -> Nothing
  
  instance DefaultOrdered ProductExportData where
      headerOrder _ = CSV.header
          [ "sku"
          , "name"
          , "price"
          , "weight"
          , "description"
          , "discontinued"
          , "qoh"
          , "category"
          , "organic"
          , "heirloom"
          , "small grower"
          , "regional"
          ]
  
  type ExportProductRoute =
         AuthProtect "cookie-auth"
      :> Capture "id" ProductId
      :> Get '[CSV] (Cookied LBS.ByteString)
  
  exportProductRoute :: WrappedAuthToken -> ProductId -> App (Cookied LBS.ByteString)
  exportProductRoute t productId = withAdminCookie t $ \_ -> runDB $ do
      products <- E.select $ do
          (p E.:& v E.:& c E.:& sa) <- E.from $ E.table @Product
              `E.innerJoin` E.table @ProductVariant
                  `E.on` (\(p E.:& v) -> v E.^. ProductVariantProductId E.==. p E.^. ProductId)
              `E.innerJoin` E.table @Category
                  `E.on` (\(p E.:& _ E.:& c) -> c E.^. CategoryId E.==. p E.^. ProductMainCategory)
              `E.leftJoin` E.table @ SeedAttribute
                  `E.on` (\(p E.:& _ E.:& _ E.:& sa) ->
                      sa E.?. SeedAttributeProductId E.==. E.just (p E.^. ProductId))
          E.where_ $ p E.^. ProductId E.==. E.val productId
          return (p, v, c, sa)
      return $ productExportData products
  
  productExportData :: [(Entity Product, Entity ProductVariant, Entity Category, Maybe (Entity SeedAttribute))] -> LBS.ByteString
  productExportData productData =
      encodeDefaultOrderedByName $ map toProductExportData productData
      where
          toProductExportData (Entity _ Product {..}, Entity _ ProductVariant {..}, Entity _ Category {..}, maybeSeedAttr) =
              ProductExportData
                  { pedSku = productBaseSku <> productVariantSkuSuffix
                  , pedName = productName
                  , pedPrice = productVariantPrice
                  , pedLotSize = productVariantLotSize
                  , pedDescription = productLongDescription
                  , pedDiscontinued = not productVariantIsActive
                  , pedQOH = fromIntegral productVariantQuantity
                  , pedCategory = categoryName
                  , pedOrganic = maybe False (seedAttributeIsOrganic . E.entityVal) maybeSeedAttr
                  , pedHeirloom = maybe False (seedAttributeIsHeirloom . E.entityVal) maybeSeedAttr
                  , pedSmallGrower = maybe False (seedAttributeIsSmallGrower . E.entityVal) maybeSeedAttr
                  , pedRegional = maybe False (seedAttributeIsRegional . E.entityVal) maybeSeedAttr
                  }
  
  type DeleteProductRoute =
         AuthProtect "cookie-auth"
      :> Capture "id" ProductId
      :> Delete '[JSON] (Cookied ())
  
  
  deleteProductRoute :: WrappedAuthToken -> ProductId -> App (Cookied ())
  deleteProductRoute t productId = withAdminCookie t $ \_ -> runDB $ do
      get productId >>= \case
          Nothing -> lift $ serverError err404
          Just _ -> do
              -- Soft delete the product by setting deleted to True
              update productId [ProductDeleted =. True]
              productVariants <- fmap entityKey <$> selectList [ProductVariantProductId ==. productId] []
              -- Delete all product variants from customer carts
              deleteWhere [CartItemProductVariantId <-. productVariants]
              -- Delete all sales with product variants
              deleteWhere [ProductSaleProductVariantId <-. productVariants]
              return ()
  
  type RestoreDeletedProductRoute =
      AuthProtect "cookie-auth"
      :> Capture "id" ProductId
      :> Post '[JSON] (Cookied ())
  
  restoreDeletedProductRoute :: WrappedAuthToken -> ProductId -> App (Cookied ())
  restoreDeletedProductRoute t productId = withAdminCookie t $ \_ -> runDB $
      get productId >>= \case
          Nothing -> lift $ serverError err404
          Just Product {..} -> do
              unless productDeleted $ lift $ serverError err404
              -- Restore the product by setting deleted to False
              update productId [ProductDeleted =. False]
              return ()
  
  -- UTILS
  
  
  makeVariant :: ProductId -> VariantData -> ProductVariant
  makeVariant pId VariantData {..} =
      ProductVariant
          { productVariantProductId = pId
          , productVariantSkuSuffix = vdSkuSuffix
          , productVariantPrice = vdPrice
          , productVariantQuantity = fromIntegral vdQuantity
          , productVariantLotSize = vdLotSize
          , productVariantIsActive = vdIsActive
          , productVariantInventoryPolicy = vdInventoryPolicy
          }
  
  makeAttributes :: ProductId -> SeedData -> SeedAttribute
  makeAttributes pId SeedData {..} =
      SeedAttribute
          { seedAttributeProductId = pId
          , seedAttributeIsOrganic = sdOrganic
          , seedAttributeIsHeirloom = sdHeirloom
          , seedAttributeIsSmallGrower = sdSmallGrower
          , seedAttributeIsRegional = sdRegional
          }
  
  getDuplicateSuffixErrors :: [VariantData] -> [(T.Text, [(T.Text, Bool)])]
  getDuplicateSuffixErrors variants =
          let duplicateSuffixes =
                  mapMaybe (\l -> if length l > 1 then listToMaybe l else Nothing)
                      $ L.group
                      $ L.sort
                      $ map vdSkuSuffix variants
          in checkDuplicateSuffix duplicateSuffixes
    where
      checkDuplicateSuffix dupes =
          let duplicateIndexes =
                  L.findIndices ((`elem` dupes) . vdSkuSuffix) variants
          in
              map (\i ->
                      ( "variant-" <> T.pack (show i) <> "-skuSuffix"
                      , [ ("SKU suffixes must be unique.", True) ]
                      )
                  )
                  duplicateIndexes
  