{-# LANGUAGE OverloadedStrings #-}
module Solr.Tag
  ( termTags
  ) where

import Control.Monad ((>=>))
import qualified Data.Aeson.Types as JSON
import qualified Data.ByteString.Char8 as BSC
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import qualified Data.Text.Encoding as TE
import qualified Network.HTTP.Client as HC
import Network.HTTP.Types.URI (renderSimpleQuery)

import Ops
import Has
import Service.DB
import HTTP.Client
import Model.Tag
import Solr.Service

parseTags :: JSON.Value -> JSON.Parser [TagName]
parseTags = JSON.withObject "terms" $
  (JSON..: "terms") >=> (JSON..: "tag_name") >=> tf where
  tf [] = return []
  tf (JSON.String n:JSON.Number _c:l) = (TagName (TE.encodeUtf8 n) :) <$> tf l
  tf _ = fail "mismatched terms"

termTags :: (MonadSolr c m, MonadDB c m) => Maybe TagName -> Int -> m [TagName]
termTags pre count = do
  req <- peeks solrRequest
  r <- focusIO $ httpRequestJSON req
    { HC.path = HC.path req <> "terms"
    , HC.queryString = renderSimpleQuery True $
      maybe id ((:) . (,) "terms.prefix" . tagNameBS) pre
      [ ("terms.fl", "tag_name")
      , ("terms.limit", BSC.pack $ show count)
      ]
    }
  fromMaybeM (map tagName <$> findTags (fromMaybe (TagName "") pre) count) $
    JSON.parseMaybe parseTags =<< r