1 {-# LANGUAGE OverloadedStrings, TupleSections #-}
    2 module Databrary.Controller.Search
    3   ( postSearchHandler
    4   ) where
    5 
    6 import Control.Monad (when)
    7 import Data.Maybe (fromMaybe)
    8 
    9 import Databrary.Has
   10 import Databrary.Model.Id.Types
   11 import Databrary.Model.Metric
   12 import Databrary.Solr.Search
   13 import Databrary.Action.Response
   14 import Databrary.Action
   15 import Databrary.HTTP.Form (FormKey(..))
   16 import Databrary.HTTP.Form.Deform
   17 import Databrary.Controller.Form
   18 import Databrary.Controller.Angular
   19 
   20 searchForm :: DeformHandler f SearchQuery
   21 searchForm = SearchQuery
   22   <$> ("q" .:> deformNonEmpty deform)
   23   <*> ("f" .:> withSubDeforms (\k -> (view k, ) <$> deform))
   24   <*> ("m" .:> withSubDeforms (\k -> (,)
   25     <$> (either deformError' return $ maybe (Left "Metric ID not found") Right . getMetric . Id =<< case k of
   26       FormField t -> textInteger t
   27       FormIndex i -> Right (fromIntegral i))
   28     <*> deform))
   29   <*> ("volume" .:> fromMaybe SearchVolumes <$> deformOptional (sv <$> deform))
   30   <*> paginateForm
   31   where
   32   sv False = SearchParties
   33   sv True = SearchVolumes
   34 
   35 postSearchHandler :: API -> Action  -- TODO: GET only
   36 postSearchHandler = \api -> withAuth $ do
   37   when (api == HTML) angular
   38   q <- runForm Nothing searchForm
   39   proxyResponse <$> search q