{-# LANGUAGE OverloadedStrings #-}
module Network.Shopify.Metafield (
    MetaFields, MetaValue(..), MetaNamespace
  , emptyMeta, setMeta, lookupMeta, lookupMetaString
  ) where

import Control.Monad
import qualified Data.Text as T
import Data.Aeson ((.:), (.=))
import qualified Data.Aeson as JS
import qualified Data.Aeson.Types as JS
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HMap
import qualified Data.Vector as V

type MetaNamespace = T.Text

data MetaValue =
    MetaString T.Text
  | MetaInt Integer
  deriving (Show)

newtype MetaFields =
    MetaFields { unMetaField :: HashMap MetaNamespace (HashMap T.Text MetaValue) }
  deriving (Show)

emptyMeta :: MetaFields
emptyMeta = MetaFields HMap.empty

setMeta :: MetaNamespace -> T.Text -> MetaValue -> MetaFields -> MetaFields
setMeta ns key val = MetaFields . HMap.insertWith HMap.union ns (HMap.singleton key val) . unMetaField

lookupMeta :: MetaNamespace -> T.Text -> MetaFields -> Maybe MetaValue
lookupMeta ns key = join . fmap (HMap.lookup key) . HMap.lookup ns . unMetaField

lookupMetaString :: MetaNamespace -> T.Text -> MetaFields -> Maybe T.Text
lookupMetaString ns key mf = 
  case lookupMeta ns key mf of
    Just (MetaString s) -> Just s
    _ -> Nothing

instance JS.FromJSON MetaFields where
  parseJSON (JS.Array a) = do
      fields <- mapM parseFields $ V.toList a
      return $ foldl (\mfs (ns, k, v) -> setMeta ns k v mfs) emptyMeta fields
    where
      parseFields (JS.Object o) = do
        ns <- o .: "namespace"
        key <- o .: "key"
        typ <- ((o .: "value_type")::JS.Parser String)
        case typ of          
          "integer" -> do
            i <- o .: "value"
            return (ns, key, MetaInt i)
          "string" -> do
            s <- o .: "value"
            return (ns, key, MetaString s)
          _ -> mzero
      parseFields _ = mzero
  parseJSON _ = mzero

instance JS.ToJSON MetaFields where
  toJSON =
      JS.toJSON . concatMap (\(ns, nsmap) -> map (\(k, v) -> objectify ns k v) $ HMap.toList nsmap) . HMap.toList . unMetaField
    where
      objectify ns k (MetaString s) = JS.object ["namespace" .= ns
                                                ,"key" .= k
                                                ,"value_type" .= ("string"::T.Text)
                                                ,"value" .= s]
      objectify ns k (MetaInt i) = JS.object ["namespace" .= ns
                                             ,"key" .= k
                                             ,"value_type" .= ("integer"::T.Text)
                                             ,"value" .= i]