{-# LANGUAGE GADTs, OverloadedStrings, FlexibleContexts #-}
-- | See detailed documentation for PostgreSQL HStore at http://www.postgresql.org/docs/9.3/static/hstore.html
module Database.Groundhog.Postgresql.HStore
  ( -- * HStore manipulation
    HStore(..)
  , (->.)
  , lookupArr
  , hstoreConcat
  , deleteKey
  , deleteKeys
  , difference
  , hstore_to_array
  , hstore_to_matrix
  , akeys
  , avals
  , slice
  , hstore_to_json
  , hstore_to_json_loose
  -- * HStore conditions
  , exist
  , defined
  , (?&)
  , (?|)
  , (@>)
  , (<@)
  ) where

import Database.Groundhog.Core
import Database.Groundhog.Expression
import Database.Groundhog.Generic
import Database.Groundhog.Generic.Sql
import Database.Groundhog.Postgresql
import Database.Groundhog.Postgresql.Array (Array)

import Database.PostgreSQL.Simple.HStore

import Data.Aeson (Value)
import qualified Blaze.ByteString.Builder as B
import Control.Applicative
import qualified Data.Map as Map
import Data.String

import           Data.Text (Text)
import qualified Data.Text.Encoding      as T

newtype HStore = HStore (Map.Map Text Text)
  deriving (Eq, Ord, Show)

instance PersistField HStore where
  persistName _ = "HStore"
  toPersistValues = primToPersistValue
  fromPersistValues = primFromPersistValue
  dbType _ _ = DbTypePrimitive (DbOther $ OtherTypeDef $ [Left "hstore"]) False Nothing Nothing

instance PrimitivePersistField HStore where
  toPrimitivePersistValue (HStore a) = PersistCustom "E?::hstore" [toPrimitivePersistValue $ T.decodeUtf8 $ B.toByteString $ toBuilder (toHStore (HStoreMap a))]
  fromPrimitivePersistValue x = case parseHStoreList $ fromPrimitivePersistValue x of
     Left err -> error $ "HStore: " ++ err
     Right (HStoreList val) -> HStore $ Map.fromList val

----------------------------------------------------------------------

psqlOperatorExpr :: (db ~ Postgresql, Expression db r a, Expression db r b) => String -> a -> b -> Expr db r c
psqlOperatorExpr op x y = mkExpr $ operator 50 op x y

psqlOperatorCond :: (db ~ Postgresql, Expression db r a, Expression db r b) => String -> a -> b -> Cond db r
psqlOperatorCond op x y = CondRaw $ operator 50 op x y

-- | Get value for key (NULL if not present)
-- 
-- @'a=>x, b=>y'::hstore -> 'a' == x@
(->.) :: (db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r key key', IsString key')
      => hstore -> key -> Expr db r (Maybe Text)
(->.) = psqlOperatorExpr "->"

-- | Get values for keys array (NULL if not present)
-- 
-- @'a=>x, b=>y, c=>z'::hstore == ARRAY['c','a']  {"z","x"}@
lookupArr :: (db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r keys (Array Text))
          => hstore -> keys -> Expr db r (Array Text)
lookupArr = psqlOperatorExpr "->"

-- | Concatenate hstores
-- 
-- @'a=>b, c=>d'::hstore || 'c=>x, d=>q'::hstore == "a"=>"b", "c"=>"x", "d"=>"q"@
hstoreConcat :: (db ~ Postgresql, ExpressionOf db r hstore1 HStore, ExpressionOf db r hstore2 HStore)
             => hstore1 -> hstore2 -> Expr db r HStore
hstoreConcat = psqlOperatorExpr "||"

-- | Does hstore contain key? Same as postgresql operator ?.
-- 
-- @'a=>1'::hstore ? 'a' == True@
exist :: (db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r key key', IsString key')
      => hstore -> key -> Cond db r
exist h k = CondRaw $ function "exist" [toExpr h, toExpr k]

-- | Does hstore contain non-NULL value for key?
-- 
-- @defined('a=>NULL','a') == f@
defined :: (db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r key key', IsString key')
      => hstore -> key -> Cond db r
defined h k = CondRaw $ function "defined" [toExpr h, toExpr k]

-- | Does hstore contain all specified keys?
-- 
-- @'a=>1,b=>2'::hstore ?& ARRAY['a','b'] == True@
(?&) :: (db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r keys (Array Text))
     => hstore -> keys -> Cond db r
(?&) = psqlOperatorCond "?&"

-- | Does hstore contain any of the specified keys?
-- 
-- @'a=>1,b=>2'::hstore ?| ARRAY['b','c'] == True@
(?|) :: (db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r keys (Array Text))
     => hstore -> keys -> Cond db r
(?|) = psqlOperatorCond "?|"

-- | Does left operand contain right?
-- 
-- @'a=>b, b=>1, c=>NULL'::hstore @> 'b=>1' == True@
(@>) :: (db ~ Postgresql, ExpressionOf db r hstore1 HStore, ExpressionOf db r hstore2 HStore)
     => hstore1 -> hstore2 -> Cond db r
(@>) = psqlOperatorCond "@>"

-- | Is left operand contained in right?
-- 
-- @'a=>c'::hstore <@ 'a=>b, b=>1, c=>NULL' == False@
(<@) :: (db ~ Postgresql, ExpressionOf db r hstore1 HStore, ExpressionOf db r hstore2 HStore)
     => hstore1 -> hstore2 -> Cond db r
(<@) = psqlOperatorCond "<@"

-- | Delete key from left operand
-- 
-- @'a=>1, b=>2, c=>3'::hstore - 'b'::text == "a"=>"1", "c"=>"3"@
deleteKey :: (db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r key key', IsString key')
          => hstore -> key -> Expr db r HStore
deleteKey h k = mkExpr $ function "delete" [toExpr h, toExpr k]

-- | Delete keys from left operand
-- 
-- @'a=>1, b=>2, c=>3'::hstore - ARRAY['a','b'] == "c"=>"3"@
deleteKeys :: (db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r keys (Array Text))
           => hstore -> keys -> Expr db r HStore
deleteKeys h k = mkExpr $ function "delete" [toExpr h, toExpr k]

-- | Delete matching pairs from left operand
-- 
-- @'a=>1, b=>2, c=>3'::hstore - 'a=>4, b=>2'::hstore == "a"=>"1", "c"=>"3"@
difference :: (db ~ Postgresql, ExpressionOf db r hstore1 HStore, ExpressionOf db r hstore2 HStore)
           => hstore1 -> hstore2 -> Expr db r HStore
difference h1 h2 = mkExpr $ function "delete" [toExpr h1, toExpr h2]

-- | Convert hstore to array of alternating keys and values. Same as prefix operator %%.
-- 
-- @hstore_to_array('a=>1,b=>2') == {a,1,b,2}@
hstore_to_array :: (db ~ Postgresql, ExpressionOf db r hstore HStore)
                => hstore -> Expr db r (Array Text)
hstore_to_array h = mkExpr $ function "hstore_to_array" [toExpr h]

-- | Convert hstore to two-dimensional key/value array. Same as prefix operator %#.
-- 
-- @hstore_to_matrix('a=>1,b=>2') == {{a,1},{b,2}}@
hstore_to_matrix :: (db ~ Postgresql, ExpressionOf db r hstore HStore)
                 => hstore -> Expr db r (Array (Array Text))
hstore_to_matrix h = mkExpr $ function "hstore_to_matrix" [toExpr h]

-- | Get hstore's keys as an array
-- 
-- @akeys('a=>1,b=>2') == {a,b}@
akeys :: (db ~ Postgresql, ExpressionOf db r hstore HStore)
          => hstore -> Expr db r (Array Text)
akeys h = mkExpr $ function "akeys" [toExpr h]

-- | Get hstore's values as an array
-- 
-- @avals('a=>1,b=>2') == {1,2}@
avals :: (db ~ Postgresql, ExpressionOf db r hstore HStore)
          => hstore -> Expr db r (Array Text)
avals h = mkExpr $ function "vals" [toExpr h]

-- | Get hstore as a json value
-- 
-- @hstore_to_json('"a key"=>1, b=>t, c=>null, d=>12345, e=>012345, f=>1.234, g=>2.345e+4') 
-- == {"a key": "1", "b": "t", "c": null, "d": "12345", "e": "012345", "f": "1.234", "g": "2.345e+4"}@
hstore_to_json :: (db ~ Postgresql, ExpressionOf db r hstore HStore)
               => hstore -> Expr db r Value
hstore_to_json h = mkExpr $ function "hstore_to_json" [toExpr h]

-- | Get hstore as a json value, but attempting to distinguish numerical and Boolean values so they are unquoted in the JSON
-- 
-- @hstore_to_json_loose('"a key"=>1, b=>t, c=>null, d=>12345, e=>012345, f=>1.234, g=>2.345e+4')
-- == {"a key": 1, "b": true, "c": null, "d": 12345, "e": "012345", "f": 1.234, "g": 2.345e+4}@
hstore_to_json_loose :: (db ~ Postgresql, ExpressionOf db r hstore HStore)
                     => hstore -> Expr db r Value
hstore_to_json_loose h = mkExpr $ function "hstore_to_json_loose" [toExpr h]

-- | Extract a subset of an hstore
-- 
-- @slice('a=>1,b=>2,c=>3'::hstore, ARRAY['b','c','x']) =="b"=>"2", "c"=>"3"@
slice :: (db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r keys (Array Text))
      => hstore -> keys -> Expr db r HStore
slice h k = mkExpr $ function "slice" [toExpr h, toExpr k]