Queries

MapReduce.hs

{-# LANGUAGE OverloadedStrings #-}
module MapReduce ( 
    queryGetMany
  , queryGetBucket
  , queryAuthUsers
  , queryAuthPToken
  ) where

import Data.Aeson
import Data.Aeson.Types
import Data.Array
import qualified Data.Vector as Vec

----------------------------------------------------------------------
-- |

mapPhase params = 
  object [ "map" .= params ]


reducePhase params = 
  object [ "reduce" .= params ]


query input phases = 
  object [ "input" .= input
         , "query" .= (Array $ Vec.fromList phases) ]


----------------------------------------------------------------------
-- |

asJSON keep = 
  object [ ("language", "erlang")
         , ("module", "snap_map")
         , ("function", "as_json")
         , ("keep", keep) ]


----------------------------------------------------------------------
-- |

matchesKV kv keep =
  object [ ("language", "erlang")
         , ("module", "snap_reduce")
         , ("function", "match_kv")
         , ("arg", object [kv])
         , ("keep", keep) ]


matchesKVs kvs keep =
  object [ ("language", "erlang")
         , ("module", "snap_reduce")
         , ("function", "match_kv")
         , ("arg", object kvs)
         , ("keep", keep) ]


----------------------------------------------------------------------
-- |

queryGetMany bucket keys =
  query input [ mapPhase $ asJSON $ Bool True ]
    where input = [ [b, k] | b <- [bucket], k <- keys ]
     
     
queryGetBucket bucket =          
  query bucket [ mapPhase $ asJSON $ Bool True ]


queryAuthUsers bucket params = 
  query bucket [ 
    mapPhase $ asJSON $ Bool False
  , reducePhase $ matchesKVs params $ Bool True 
  ]

            
queryAuthPToken bucket token =
  query bucket [ 
    mapPhase $ asJSON $ Bool False
  , reducePhase $ matchesKV ("persistence_token", token) $ Bool True
  ]

snap_map.erl

%%--------------------------------------------------------------------
%% Useful map phases
-module(snap_map).

-export([as_json/3]).


%%--------------------------------------------------------------------
%% Encode an Erlang Riak Object to JSON
as_json(Object, undefined, none) -> 
    [mochijson2:decode(riak_object:get_value(Object))].

snap_reduce.erl

%%--------------------------------------------------------------------
%% Useful reduce phases
-module(snap_reduce).

-export([match_kv/2]).


%%--------------------------------------------------------------------
%% 
has_kv(Object, Params) ->
    HasKV = fun({ParamK, ParamV}, _) ->
		    case lists:keyfind(ParamK, 1, Object) of
			{_, V} -> ParamV =:= V;
			false  -> false
		    end
	    end,
    lists:foldl(HasKV, true, Params).


%%--------------------------------------------------------------------
%%
match_kv(Objects, {struct, Params}) ->
    [{struct, O} || {struct, O} <- Objects, has_kv(O, Params)].