add Pure.hs

This commit is contained in:
Greg Hale 2018-01-10 18:41:39 -05:00
parent 6030a8f216
commit 3bac4e5465
3 changed files with 79 additions and 4 deletions

View File

@ -7,5 +7,7 @@ in reflex-platform.ghc.override {
servant-snap = dc (self.callPackage (c2n deps/servant-snap) {});
heist = dc (self.callPackage (c2n deps/servant-snap/deps/snap/deps/heist) {});
xmlhtml = dc (self.callPackage (c2n deps/servant-snap/deps/snap/deps/xmlhtml) {});
servant = dc (self.callPackage (c2n deps/servant/servant) {});
servant-client-core = dc (self.callPackage (c2n deps/servant/servant-client-core) {});
};
}

View File

@ -1,5 +1,5 @@
Name: servant-reflex
Version: 0.3.3
Version: 0.3.4
Synopsis: Servant reflex API generator
Description: Servant reflex API generator
License: BSD3
@ -19,10 +19,10 @@ library
exposed-modules:
Servant.Reflex
Servant.Reflex.Multi
other-modules:
Servant.Reflex.Pure
Servant.Common.BaseUrl
Servant.Common.Req
other-modules:
hs-source-dirs: src
build-depends:
@ -41,7 +41,8 @@ library
reflex >= 0.5 && < 0.6,
reflex-dom == 0.4 && < 0.5,
safe >= 0.3.9 && < 0.4,
servant >= 0.8 && < 0.12,
servant >= 0.12 && < 0.13,
servant-client-core,
servant-auth >= 0.2.1 && < 0.4,
string-conversions >= 0.4 && < 0.5,
text >= 1.2 && < 1.3,

View File

@ -0,0 +1,72 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
#if MIN_VERSION_base(4,9,0)
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
#endif
module Servant.Reflex.Pure where
------------------------------------------------------------------------------
import Control.Applicative
import Data.Monoid ((<>))
import qualified Data.Set as Set
import qualified Data.Text.Encoding as E
import Data.CaseInsensitive (mk)
import Data.Functor.Identity
import Data.Proxy (Proxy (..))
import qualified Data.Map as Map
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Exts (Constraint)
import GHC.TypeLits (KnownSymbol, symbolVal)
import Servant.API ((:<|>)(..),(:>), BasicAuth,
BasicAuthData, BuildHeadersTo(..),
Capture, contentType, Header,
Headers(..), HttpVersion, IsSecure,
MimeRender(..), MimeUnrender,
NoContent, QueryFlag, QueryParam,
QueryParams, Raw, ReflectMethod(..),
RemoteHost, ReqBody,
ToHttpApiData(..), Vault, Verb)
import qualified Servant.Auth as Auth
import qualified Servant.Client.Core as S
import Reflex.Dom
------------------------------------------------------------------------------
import Servant.Common.BaseUrl (BaseUrl(..), Scheme(..), baseUrlWidget,
showBaseUrl,
SupportsServantReflex)
data CallParts a = CallParts
{ _reqParts :: S.Request
, _respDecoder :: S.Response -> Either Text a
}
class HasClient (m :: * -> *) (api :: *) where
type Client (m :: * -> *) (api :: *) :: *
clientWithRoute :: Proxy m -> Proxy api -> CallParts r -> Client m api
instance (HasClient m a, HasClient m b) => HasClient m (a :<|> b) where
type Client m (a :<|> b) = Client m a :<|> Client m b
clientWithRoute pM pLayout cp = clientWithRoute pM (Proxy :: Proxy a) cp :<|> clientWithRoute pM (Proxy :: Proxy b) cp
instance (KnownSymbol capture, ToHttpApiData a, HasClient m rest) => HasClient m (Capture capture a :> rest) where
type Client m (Capture capture a :> rest) = Either Text a -> Client m rest
clientWithRoute pM pLayout a cp = clientWithRoute pM (Proxy :: Proxy rest) _
where auxParts = _ -- cp { _reqParts = S.appendToPath _ (_reqParts cp) }