named-servant (empty) → 0.0.1

raw patch · 3 files changed

+113/−0 lines, 3 filesdep +basedep +nameddep +servant

Dependencies added: base, named, servant

Files

• LICENSE +29/−0
• named-servant.cabal +25/−0
• src/Servant/Named.hs +59/−0

@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2020, Kristof Bastiaensen+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+   contributors may be used to endorse or promote products derived from+   this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,25 @@+cabal-version: 1.12+name: named-servant+description: support named parameters in servant using the named package+version: 0.0.1+maintainer: kristof@resonata.be+copyright: Kristof Bastiaensen 2020+license: BSD3+license-file: LICENSE+build-type: Simple++source-repository head+    type: git+    location: https://github.com/kuribas/named-servant++library+   default-language: Haskell2010+   Ghc-options: -Wall+   exposed-modules:+        Servant.Named+   hs-source-dirs:+        src+   build-depends:+        base >= 4.7 && < 5,+        servant,+        named

@@ -0,0 +1,59 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE EmptyDataDecls #-}+module Servant.Named (NamedQueryParam, OptionalQueryParam, NamedQueryParams,+                      NamedQueryParam') where+import Servant.API+import Servant.API.Modifiers+import Data.Proxy+import GHC.TypeLits+import Data.Functor.Identity+import Named++-- | Like `QueryParam'`, but instead of extracting a type @a@, it+-- extracts a named type @`NamedF` f a sym@, where the name+-- corresponds to the query parameter string.+data NamedQueryParam' (mods :: [*]) (sym :: Symbol) (a :: *)++unarg :: NamedF f a name -> f a+unarg (ArgF a) = a++instance (KnownSymbol sym, ToHttpApiData v, HasLink sub,+          SBoolI (FoldRequired mods))+    => HasLink (NamedQueryParam' mods sym v :> sub)+  where+    type MkLink (NamedQueryParam' mods sym v :> sub) a =+      If (FoldRequired mods) (sym :! v) (sym :? v) -> MkLink sub a+    toLink toA _ l qparam =+      toLink toA (Proxy :: Proxy (QueryParam' mods sym v :> sub)) l $+      case sbool :: SBool (FoldRequired mods) of+        STrue  -> runIdentity (unarg qparam)+        SFalse -> unarg qparam++-- | Lookup the value associated to the sym query string parameter and+-- try to extract it as an optional named argument of type @sym `:?`+-- a@.+type OptionalQueryParam = NamedQueryParam' [Optional, Strict]++-- | Like `QueryParam`, but instead of extracting a type @a@, it+-- extracts a named type @named `:!` a@, where named corresponds to+-- the query parameter string.+type NamedQueryParam = NamedQueryParam' [Required, Strict]++-- | Like `QueryParams`, but extracts a named type @named `:!` [a]@+-- instead, where named corresponds to the query parameter string.+data NamedQueryParams (sym :: Symbol) (a :: *)++instance (KnownSymbol sym, ToHttpApiData v, HasLink sub)+         => HasLink (NamedQueryParams sym v :> sub)+  where+    type MkLink (NamedQueryParams sym v :> sub) a = sym :! [v] -> MkLink sub a+    toLink toA _ l (Arg params) =+      toLink toA (Proxy :: Proxy (QueryParams sym v :> sub)) l params+