packages feed

solr (empty) → 0.2.1.5

raw patch · 9 files changed

+680/−0 lines, 9 filesdep +base-preludedep +bytestringdep +bytestring-tree-buildersetup-changed

Dependencies added: base-prelude, bytestring, bytestring-tree-builder, case-insensitive, contravariant, http-client, http-response-decoder, json-encoder, json-incremental-decoder, matcher, profunctors, semigroups, text, transformers, uri-encode

Files

+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2016, Sannsyn AS++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ library/Solr/HTTPRequestEncoder.hs view
@@ -0,0 +1,121 @@+module Solr.HTTPRequestEncoder where++import Solr.Prelude+import qualified Data.ByteString.Lazy+import qualified Data.ByteString.Char8+import qualified Data.CaseInsensitive+import qualified JSONEncoder+import qualified Network.HTTP.Client+import qualified ByteString.TreeBuilder+++encoder_request :: Request a -> a -> Network.HTTP.Client.Request+encoder_request (Request (Op impl)) input =+  appEndo (impl input) init+  where+    init =+      either (error . show) id $+      Network.HTTP.Client.parseUrl "http://www"+++newtype Request a =+  Request (Op (Endo Network.HTTP.Client.Request) a)+  deriving (Contravariant, Divisible, Decidable, Semigroup, Monoid)++request_body :: Body a -> Request a+request_body (Body impl) =+  Request $+  Op $+  \input ->+    Endo $+    \request ->+      request {+        Network.HTTP.Client.requestBody = (impl input)+      }++request_method :: ByteString -> Request a+request_method method =+  Request $+  Op $+  const $+  Endo $+  \request ->+    request {+      Network.HTTP.Client.method = method+    }++request_header :: ByteString -> ByteString -> Request a+request_header name value =+  Request $+  Op $+  const $+  Endo $+  \request ->+    request {+      Network.HTTP.Client.requestHeaders =+        (Data.CaseInsensitive.mk name, value) :+        Network.HTTP.Client.requestHeaders request+    }++request_url :: ByteString -> Request a+request_url url =+  Request $+  Op $+  const $+  Endo $+  case parsedRequestMaybe of+    Just parsedRequest ->+      \request ->+        request {+          Network.HTTP.Client.secure =+            Network.HTTP.Client.secure parsedRequest,+          Network.HTTP.Client.host =+            Network.HTTP.Client.host parsedRequest,+          Network.HTTP.Client.port =+            Network.HTTP.Client.port parsedRequest,+          Network.HTTP.Client.path =+            Network.HTTP.Client.path parsedRequest,+          Network.HTTP.Client.queryString =+            Network.HTTP.Client.queryString parsedRequest+        }+    Nothing -> id+  where+    parsedRequestMaybe =+      Network.HTTP.Client.parseUrl $+      Data.ByteString.Char8.unpack $+      url+++newtype Body a =+  Body (a -> Network.HTTP.Client.RequestBody)++instance Contravariant Body where+  {-# INLINE contramap #-}+  contramap f (Body impl) =+    Body (\input -> impl (f input))++body_unit :: Body ()+body_unit =+  Body $+  const $+  Network.HTTP.Client.RequestBodyBS mempty++body_json :: JSONEncoder.Value a -> Body a+body_json spec =+  Body $+  \input ->+    Network.HTTP.Client.RequestBodyLBS $+    ByteString.TreeBuilder.toLazyByteString $+    JSONEncoder.run spec input+++-- * Specific+-------------------------++request_postJSON :: ByteString -> JSONEncoder.Value a -> Request a+request_postJSON url jsonEncoder =+  request_url url <>+  request_method "POST" <>+  request_header "content-type" "application/json" <>+  request_body (body_json jsonEncoder)+
+ library/Solr/HTTPResponseDecoder.hs view
@@ -0,0 +1,45 @@+module Solr.HTTPResponseDecoder+(+  json,+  okay,+  module HTTPResponseDecoder,+)+where++import Solr.Prelude+import HTTPResponseDecoder+import qualified Data.ByteString.Lazy+import qualified JSONIncrementalDecoder+++response :: Matcher ByteString () -> Matcher Int () -> Matcher Data.ByteString.Lazy.ByteString a -> Response a+response contentTypeMatcher statusCodeMatcher bodyMatcher =+  fmap snd $+  headAndBody head body+  where+    head =+      statusCode statusCodeMatcher *>+      headers (header "content-type" contentTypeMatcher)+    body =+      bodyLazyBytes bodyMatcher++statusIsOkay :: Matcher Int ()+statusIsOkay =+  equals 200++contentTypeIsJSON :: Matcher ByteString ()+contentTypeIsJSON =+  equals "application/json"++jsonBodyMatcher :: JSONIncrementalDecoder.Value a -> Matcher Data.ByteString.Lazy.ByteString a+jsonBodyMatcher spec =+  converts (JSONIncrementalDecoder.valueToLazyByteStringToEither spec)++json :: JSONIncrementalDecoder.Value a -> Response a+json spec =+  response whatever statusIsOkay (jsonBodyMatcher spec)+      +okay :: Response ()+okay =+  response whatever statusIsOkay whatever+
+ library/Solr/Parameters.hs view
@@ -0,0 +1,84 @@+-- |+-- For details see <http://wiki.apache.org/solr/CommonParametersParameters the Solr documentation>.+module Solr.Parameters+(+  builderEncoder_parameters,+  Parameters,+  parameters_select,+  Select,+  select_q,+  select_start,+  select_rows,+)+where++import Solr.Prelude+import qualified Network.URI.Encode+import qualified ByteString.TreeBuilder+++builderEncoder_parameters :: Parameters a -> a -> ByteString.TreeBuilder.Builder+builderEncoder_parameters (Parameters (Op impl)) =+  \input ->+    fold $+    intersperse "&" $+    fmap pairMapping $+    impl input []+  where+    pairMapping (name, value) =+      if ByteString.TreeBuilder.length value == 0+        then name+        else name <> "=" <> value+++newtype Parameters a =+  Parameters (Op ([(ByteString.TreeBuilder.Builder, ByteString.TreeBuilder.Builder)] -> [(ByteString.TreeBuilder.Builder, ByteString.TreeBuilder.Builder)]) a)+  deriving (Contravariant, Divisible, Decidable, Semigroup, Monoid)++{-# INLINE parameters_parameter #-}+parameters_parameter :: Parameters (ByteString.TreeBuilder.Builder, ByteString.TreeBuilder.Builder)+parameters_parameter =+  Parameters $+  Op $+  \(name, value) ->+    (:) (name, value)++{-# INLINE parameters_select #-}+parameters_select :: Select a -> Parameters a+parameters_select (Select spec) =+  spec+++-- |+-- Select parameters encoder.+newtype Select a =+  Select (Parameters a)+  deriving (Contravariant, Divisible, Decidable, Semigroup, Monoid)++-- |+-- The actual search-query.+-- See <http://wiki.apache.org/solr/SolrQuerySyntax>.+{-# INLINE select_q #-}+select_q :: Select Text+select_q =+  Select $+  contramap (ByteString.TreeBuilder.byteString . Network.URI.Encode.encodeTextToBS) $+  contramap (\x -> ("q", x)) $+  parameters_parameter++{-# INLINE select_start #-}+select_start :: Select Int+select_start =+  Select $+  contramap (ByteString.TreeBuilder.asciiIntegral) $+  contramap (\x -> ("start", x)) $+  parameters_parameter++{-# INLINE select_rows #-}+select_rows :: Select Int+select_rows =+  Select $+  contramap (ByteString.TreeBuilder.asciiIntegral) $+  contramap (\x -> ("rows", x)) $+  parameters_parameter+
+ library/Solr/Prelude.hs view
@@ -0,0 +1,46 @@+module Solr.Prelude+( +  module Exports,+)+where+++-- base-prelude+-------------------------+import BasePrelude as Exports hiding (First(..), Last(..), (<>))++-- transformers+-------------------------+import Control.Monad.IO.Class as Exports+import Control.Monad.Trans.Class as Exports+import Control.Monad.Trans.Except as Exports hiding (liftCallCC, liftCatch, liftListen, liftPass)+import Control.Monad.Trans.Maybe as Exports hiding (liftCallCC, liftCatch, liftListen, liftPass)+import Control.Monad.Trans.Reader as Exports hiding (liftCallCC, liftCatch, liftListen, liftPass)+import Control.Monad.Trans.State.Strict as Exports hiding (liftCallCC, liftCatch, liftListen, liftPass)+import Control.Monad.Trans.Writer.Strict as Exports++-- contravariant+-------------------------+import Data.Functor.Contravariant as Exports+import Data.Functor.Contravariant.Divisible as Exports++-- profunctors+-------------------------+import Data.Profunctor.Unsafe as Exports++-- semigroup+-------------------------+import Data.Semigroup as Exports++-- matcher+-------------------------+import Matcher as Exports hiding (run)++-- bytestring+-------------------------+import Data.ByteString as Exports (ByteString)++-- text+-------------------------+import Data.Text as Exports (Text)+
+ library/Solr/Request.hs view
@@ -0,0 +1,241 @@+-- |+-- Request declaration DSL.+module Solr.Request+(+  -- * Request+  Request(..),+  request_select,+  request_count,+  request_update,+  -- * Encoders+  Encoder_Select,+  encoder_select_query,+  encoder_select_filter,+  encoder_select_offset,+  encoder_select_limit,+  Encoder_Update,+  encoder_update_add,+  encoder_update_delete,+  Encoder_Add,+  encoder_add_doc,+  encoder_add_boost,+  encoder_add_overwrite,+  encoder_add_commitWithin,+  Encoder_Delete,+  encoder_delete_id,+  encoder_delete_query,+  encoder_delete_commitWithin,+  -- * Decoders+  Decoder_Select,+  decoder_select_response,+  Decoder_Response,+  decoder_response_numFound,+  decoder_response_docs,+  Decoder_Docs,+  decoder_docs_doc,+)+where++import Solr.Prelude+import qualified Solr.HTTPResponseDecoder+import qualified Solr.HTTPRequestEncoder+import qualified Solr.Parameters+import qualified JSONEncoder+import qualified JSONIncrementalDecoder+++-- |+-- Solr request specification.+data Request a b =+  Request+    !(ByteString -> Solr.HTTPRequestEncoder.Request a)+    !(Solr.HTTPResponseDecoder.Response b)++instance Functor (Request a) where+  {-# INLINE fmap #-}+  fmap f (Request requestEncoderProducer responseDecoder) =+    Request requestEncoderProducer (fmap f responseDecoder)++instance Profunctor Request where+  {-# INLINE dimap #-}+  dimap f1 f2 (Request requestEncoderProducer responseDecoder) =+    Request ((fmap . contramap) f1 requestEncoderProducer) (fmap f2 responseDecoder)+++request_select :: Encoder_Select a -> Decoder_Select b -> Request a b+request_select selectEncoder selectDecoder =+  Request requestEncoderProducer responseDecoder+  where+    requestEncoderProducer baseURL =+      Solr.HTTPRequestEncoder.request_postJSON url jsonEncoder+      where+        url =+          baseURL <> "/select/?wt=json"+        jsonEncoder =+          encoder_value_select selectEncoder+    responseDecoder =+      Solr.HTTPResponseDecoder.json $+      decoder_value_select $+      selectDecoder++request_count :: Request Text Int+request_count =+  request_select encoder decoder+  where+    encoder =+      encoder_select_query <>+      contramap (const 0) encoder_select_limit+    decoder =+      decoder_select_response $+      decoder_response_numFound++request_update :: Encoder_Update a -> Request a ()+request_update updateEncoder =+  Request requestEncoderProducer responseDecoder+  where+    requestEncoderProducer baseURL =+      Solr.HTTPRequestEncoder.request_postJSON url jsonEncoder+      where+        url =+          baseURL <> "/update/?commit=true"+        jsonEncoder =+          encoder_value_update updateEncoder+    responseDecoder =+      Solr.HTTPResponseDecoder.okay+++++encoder_value_select :: Encoder_Select a -> JSONEncoder.Value a+encoder_value_select (Encoder_Select spec) =+  JSONEncoder.object spec++encoder_value_update :: Encoder_Update a -> JSONEncoder.Value a+encoder_value_update (Encoder_Update spec) =+  JSONEncoder.object spec+++-- q = query+-- fq = filter+-- fl = JSONEncoder.fields+-- start = offset+-- rows = limit+-- sort = sort+newtype Encoder_Select a =+  Encoder_Select (JSONEncoder.Object a)+  deriving (Contravariant, Divisible, Decidable, Semigroup, Monoid)++encoder_select_query :: Encoder_Select Text+encoder_select_query =+  Encoder_Select (JSONEncoder.field "query" JSONEncoder.string)++encoder_select_filter :: Encoder_Select [Text]+encoder_select_filter =+  Encoder_Select (JSONEncoder.field "filter" (JSONEncoder.array (JSONEncoder.homo foldl' JSONEncoder.string)))++encoder_select_offset :: Encoder_Select Int+encoder_select_offset =+  Encoder_Select (JSONEncoder.field "offset" JSONEncoder.number_integral)++encoder_select_limit :: Encoder_Select Int+encoder_select_limit =+  Encoder_Select (JSONEncoder.field "limit" JSONEncoder.number_integral)++++newtype Encoder_Update a =+  Encoder_Update (JSONEncoder.Object a)+  deriving (Contravariant, Divisible, Decidable, Semigroup, Monoid)++encoder_update_add :: Encoder_Add a -> Encoder_Update a+encoder_update_add (Encoder_Add spec) =+  Encoder_Update (JSONEncoder.field "add" (JSONEncoder.object spec))++encoder_update_delete :: Encoder_Delete a -> Encoder_Update a+encoder_update_delete (Encoder_Delete spec) =+  Encoder_Update (JSONEncoder.field "delete" (JSONEncoder.object spec))+++newtype Encoder_Add a =+  Encoder_Add (JSONEncoder.Object a)+  deriving (Contravariant, Divisible, Decidable, Semigroup, Monoid)++encoder_add_doc :: JSONEncoder.Value a -> Encoder_Add a+encoder_add_doc spec =+  Encoder_Add (JSONEncoder.field "doc" spec)++encoder_add_boost :: Encoder_Add Double+encoder_add_boost =+  Encoder_Add (JSONEncoder.field "boost" (contramap realToFrac JSONEncoder.number_scientific))++encoder_add_overwrite :: Encoder_Add Bool+encoder_add_overwrite =+  Encoder_Add (JSONEncoder.field "overwrite" JSONEncoder.boolean)++-- |+-- Specifies the amount of milliseconds (10^-3).+encoder_add_commitWithin :: Encoder_Add Int+encoder_add_commitWithin =+  Encoder_Add (JSONEncoder.field "commitWithin" JSONEncoder.number_integral)+++newtype Encoder_Delete a =+  Encoder_Delete (JSONEncoder.Object a)+  deriving (Contravariant, Divisible, Decidable, Semigroup, Monoid)++encoder_delete_id :: Encoder_Delete Text+encoder_delete_id =+  Encoder_Delete (JSONEncoder.field "id" JSONEncoder.string)++encoder_delete_query :: Encoder_Delete Text+encoder_delete_query =+  Encoder_Delete (JSONEncoder.field "query" JSONEncoder.string)++-- |+-- Specifies the amount of milliseconds (10^-3).+encoder_delete_commitWithin :: Encoder_Delete Int+encoder_delete_commitWithin =+  Encoder_Delete (JSONEncoder.field "commitWithin" JSONEncoder.number_integral)+++-- * Decoders+-------------------------++decoder_value_select :: Decoder_Select a -> JSONIncrementalDecoder.Value a+decoder_value_select (Decoder_Select spec) =+  JSONIncrementalDecoder.objectLookup spec+++newtype Decoder_Select a =+  Decoder_Select (JSONIncrementalDecoder.ObjectLookup a)+  deriving (Functor, Applicative)++decoder_select_response :: Decoder_Response a -> Decoder_Select a+decoder_select_response (Decoder_Response spec) =+  Decoder_Select (JSONIncrementalDecoder.atKey "response" (JSONIncrementalDecoder.objectLookup spec))+++-- |+-- JSON decoder in the context of the \"response\" schema.+newtype Decoder_Response a =+  Decoder_Response (JSONIncrementalDecoder.ObjectLookup a)+  deriving (Functor, Applicative)++decoder_response_numFound :: Decoder_Response Int+decoder_response_numFound =+  Decoder_Response $+  JSONIncrementalDecoder.atKey "numFound" JSONIncrementalDecoder.numberAsInt++decoder_response_docs :: Decoder_Docs a -> Decoder_Response a+decoder_response_docs (Decoder_Docs spec) =+  Decoder_Response (JSONIncrementalDecoder.atKey "docs" (JSONIncrementalDecoder.arrayElements spec))+++newtype Decoder_Docs a =+  Decoder_Docs (JSONIncrementalDecoder.ArrayElements a)+  deriving (Functor, Applicative, Alternative, Monad, MonadPlus)++decoder_docs_doc :: JSONIncrementalDecoder.Value a -> Decoder_Docs a+decoder_docs_doc spec =+  Decoder_Docs (JSONIncrementalDecoder.element spec)+
+ library/Solr/Session.hs view
@@ -0,0 +1,50 @@+module Solr.Session+(+  Session,+  request,+  -- * Execution+  Error(..),+  run,+)+where++import Solr.Prelude+import qualified Network.HTTP.Client+import qualified Data.ByteString.Lazy+import qualified Data.ByteString+import qualified Solr.Request+import qualified Solr.HTTPRequestEncoder+import qualified HTTPResponseDecoder+++newtype Session a =+  Session (ReaderT Env (ExceptT Error IO) a)+  deriving (Functor, Applicative, Monad, MonadIO)++type Env =+  (ByteString, Network.HTTP.Client.Manager)++data Error =+  Error_Decoding !Text |+  Error_Transport !Network.HTTP.Client.HttpException+  deriving (Show)++run :: Session a -> ByteString -> Network.HTTP.Client.Manager -> IO (Either Error a)+run (Session impl) baseURL httpManager =+  runExceptT (runReaderT impl (baseURL, httpManager))++request :: Solr.Request.Request a b -> a -> Session b+request (Solr.Request.Request encoderProducer decoder) input =+  Session $+  ReaderT $+  \(baseURL, httpManager) ->+    ExceptT $+    fmap (either (Left . Error_Transport) (either (Left . Error_Decoding) Right)) $+    try $+    Network.HTTP.Client.withResponse (request baseURL) httpManager $+    responseDecoder+  where+    request baseURL =+      Solr.HTTPRequestEncoder.encoder_request (encoderProducer baseURL) input+    responseDecoder =+      HTTPResponseDecoder.run decoder
+ solr.cabal view
@@ -0,0 +1,69 @@+name:+  solr+version:+  0.2.1.5+synopsis:+  A minimal Solr client library+homepage:+  https://github.com/sannsyn/solr+bug-reports:+  https://github.com/sannsyn/solr/issues+author:+  Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+  Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+  (c) 2016, Sannsyn AS+license:+  MIT+license-file:+  LICENSE+build-type:+  Simple+cabal-version:+  >=1.10+++source-repository head+  type:+    git+  location:+    git://github.com/sannsyn/solr.git+++library+  hs-source-dirs:+    library+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+  other-modules:+    Solr.Prelude+    Solr.HTTPResponseDecoder+    Solr.HTTPRequestEncoder+    Solr.Parameters+  exposed-modules:+    Solr.Session+    Solr.Request+  build-depends:+    -- networking:+    http-response-decoder >= 0.2 && < 0.3,+    http-client >= 0.4.27 && < 0.5,+    uri-encode >= 1.5 && < 2,+    -- json:+    json-encoder >= 0.1.5 && < 0.2,+    json-incremental-decoder >= 0.1.0.1 && < 0.2,+    -- data:+    bytestring-tree-builder >= 0.2.5 && < 0.3,+    bytestring >= 0.10 && < 0.11,+    text >= 1 && < 2,+    case-insensitive >= 1.2 && < 2,+    -- general:+    matcher >= 0.1.1 && < 0.2,+    semigroups >= 0.18 && < 0.19,+    profunctors >= 5.2 && < 6,+    contravariant >= 1.4 && < 2,+    transformers >= 0.4 && < 0.6,+    base-prelude < 2+