diff --git a/hunt-searchengine/hunt-searchengine.cabal b/hunt-searchengine/hunt-searchengine.cabal index c0bf4528..41e0e467 100644 --- a/hunt-searchengine/hunt-searchengine.cabal +++ b/hunt-searchengine/hunt-searchengine.cabal @@ -31,7 +31,7 @@ source-repository head library - build-depends: aeson >= 0.6 + build-depends: aeson >= 1.0.0.0 , aeson-pretty >= 0.7 , base >= 4.8 && < 5 , binary >= 0.5 && < 1 diff --git a/hunt-searchengine/src/Hunt/Common/DocDesc.hs b/hunt-searchengine/src/Hunt/Common/DocDesc.hs index 728c3f4d..8bb72b73 100644 --- a/hunt-searchengine/src/Hunt/Common/DocDesc.hs +++ b/hunt-searchengine/src/Hunt/Common/DocDesc.hs @@ -6,23 +6,26 @@ module Hunt.Common.DocDesc where -import Prelude hiding (lookup) +import Prelude hiding (lookup) -import Control.Arrow (second) +import Control.Arrow (second) import Control.DeepSeq -import Control.Monad (mzero) - -import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), - decode, encode) -import Data.Binary (Binary (..)) -import Data.ByteString (ByteString) -import qualified Data.HashMap.Strict as HM -import Data.Maybe (fromMaybe) -import qualified Data.Scientific as Scientific +import Control.Monad (mzero) + +import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), + decode, decode', encode) +import qualified Data.Aeson.Encoding.Internal as Enc +import Data.Binary (Binary (..)) +import qualified Data.ByteString.Builder as Builder +import Data.ByteString (ByteString) +import qualified Data.ByteString.Lazy as LBS +import qualified Data.HashMap.Strict as HM +import Data.Maybe (fromMaybe) +import qualified Data.Scientific as Scientific import Data.String -import Data.Text (Text) -import qualified Data.Text as Text -import Data.Text.Binary () +import Data.Text (Text) +import qualified Data.Text as Text +import Data.Text.Binary () import Data.Typeable -- ------------------------------------------------------------ @@ -35,10 +38,14 @@ type FieldRank = Int data FieldValue = FV_Int !Int | FV_Float !Float | FV_Text !Text + | FV_Json !ByteString | FV_Binary !ByteString | FV_Null deriving (Eq, Show) +jsonValue :: ToJSON a => a -> FieldValue +jsonValue = FV_Json . LBS.toStrict . encode + instance IsString FieldValue where fromString = FV_Text . fromString @@ -51,16 +58,27 @@ instance FromJSON FieldValue where Number n -> pure $ case Scientific.floatingOrInteger n of Left f -> toFieldValue (f :: Float) Right i -> toFieldValue (i :: Int) - _ -> mzero + x -> pure $ jsonValue x instance ToJSON FieldValue where toJSON fv = case fv of FV_Int i -> toJSON i FV_Float f -> toJSON f FV_Text s -> toJSON s + FV_Json j -> case decode' (LBS.fromStrict j) of + Just v -> v + Nothing -> error "invalid" FV_Binary _ -> Null -- TODO: maybe base64 encode binary values FV_Null -> Null + toEncoding fv = case fv of + FV_Int i -> toEncoding i + FV_Float f -> toEncoding f + FV_Text t -> toEncoding t + FV_Json j -> Enc.unsafeToEncoding (Builder.byteString j) + FV_Binary _ -> toEncoding Null -- TODO: see toJSON + FV_Null -> toEncoding Null + class ToFieldValue a where toFieldValue :: a -> FieldValue diff --git a/stack.yaml b/stack.yaml index 1189d99c..26e3992c 100644 --- a/stack.yaml +++ b/stack.yaml @@ -8,14 +8,15 @@ packages: - ./hunt-server - ./hunt-test/data/jokes extra-deps: - - servant-0.9.1.1 - - servant-server-0.9.1.1 - - servant-client-0.9.1.1 - - http-api-data-0.3.2 + - aeson-1.0.2.1 - data-r-tree-0.0.5.0 - data-stringmap-1.0.1.1 + - http-api-data-0.3.2 - hxt-cache-9.1.0.1 - hxt-xpath-9.1.2.2 + - servant-0.9.1.1 + - servant-client-0.9.1.1 + - servant-server-0.9.1.1 - store-0.3 - store-core-0.3 resolver: nightly-2016-08-06