servant-flatten (empty) → 0.1

raw patch · 6 files changed

+216/−0 lines, 6 filesdep +basedep +servantsetup-changed

Dependencies added: base, servant

Files

• ChangeLog.md +5/−0
• LICENSE +30/−0
• README.md +38/−0
• Setup.hs +2/−0
• servant-flatten.cabal +31/−0
• src/Servant/API/Flatten.hs +110/−0

@@ -0,0 +1,5 @@+# Revision history for servant-flatten++## 0.1 -- 2017-03-16++* First version.

@@ -0,0 +1,30 @@+Copyright (c) 2018, Alp Mestanogullari++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of Alp Mestanogullari nor the names of other+      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+OWNER 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,38 @@+# servant-flatten++Utilities for flattening servant API types++The main function from this library is:++``` haskell+flatten :: Proxy api -> Proxy (Flat api)+```++Its purpose is to "flatten" an API type, by distributing+any factored combinators, so as to end up with completely+flat endpoint descriptions, separated by `:<|>`s.++For example, it turns:++``` haskell+type API = Capture "foo" Int :>+  ( Capture "bar" String :>+      ( Get '[JSON] String :<|>+        ReqBody '[JSON] Int :> Post '[JSON] Int+      ) :<|>+    Get '[JSON] Int+  ) :<|>+  Get '[JSON] [String]+```++into:++``` haskell+Capture "foo" Int :> Capture "bar" String :> Get '[JSON] String :<|>+Capture "foo" Int :> Capture "bar" String :> ReqBody '[JSON] Int :> Post '[JSON] Int :<|>+Capture "foo" Int :> Get '[JSON] Int :<|>+Get '[JSON] [String]+```++See the documentation of `flatten` in `src/Servant/API/Flatten.hs`+for more explanations and some examples.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,31 @@+name:                servant-flatten+version:             0.1+synopsis:            Utilities for flattening servant API types+description:         Utilities for flattening servant API types+                     .+                     See the documentation of @'Servant.API.Flatten.flatten'@.+homepage:            https://github.com/alpmestan/servant-flatten+bug-reports:         http://github.com/alpmestan/servant-flatten/issues+license:             BSD3+license-file:        LICENSE+author:              Alp Mestanogullari+maintainer:          alpmestan@gmail.com+copyright:           2018 Alp Mestanogullari, Julian Arni+category:            Web+build-type:          Simple+extra-source-files:  ChangeLog.md, README.md+cabal-version:       >=1.10+tested-with:         GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.1++source-repository head+  type:     git+  location: https://github.com/alpmestan/servant-flatten.git++library+  exposed-modules:     Servant.API.Flatten+  other-extensions:    DataKinds, PolyKinds, TypeFamilies, TypeOperators,+                       FlexibleContexts, UndecidableInstances+  build-depends:       base >=4.8 && <5, servant >= 0.8+  hs-source-dirs:      src+  default-language:    Haskell2010+  ghc-options:         -Wall

@@ -0,0 +1,110 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+module Servant.API.Flatten where++import Data.Proxy+import GHC.TypeLits+import Servant.API++-- | Flatten (a 'Proxy' to) an API type.+--+--   This performs a number of transformations on the API type so+--   as to end up with all combinators distributed over endpoints.+--   For example, the following API type:+--+--   @+--   type API = 'Capture' "foo" 'Int' ':>'+--     ( 'Capture' "bar" 'String' ':>'+--         ( 'Get' '['JSON'] 'String' ':<|>'+--           'ReqBody' '['JSON'] 'Int' ':>' 'Post' '['JSON'] 'Int'+--         ) ':<|>'+--       'Get' '['JSON'] 'Int'+--     ) ':<|>'+--     'Get' '['JSON'] ['String']+--   @+--+--   gets transformed into:+--+--   @+--   'Capture' "foo" 'Int' ':>' 'Capture' "bar" 'String' ':>' 'Get' '['JSON'] 'String' ':<|>'+--   'Capture' "foo" 'Int' ':>' 'Capture' "bar" 'String' ':>' 'ReqBody' '[JSON] 'Int' ':>' 'Post' '['JSON'] 'Int' ':<|>'+--   'Capture' "foo" 'Int' ':>' 'Get' '['JSON'] 'Int' ':<|>'+--   'Get' '['JSON'] ['String']+--   @+--+--   The main point of doing this is to avoid \"nested types\" for server-side handlers+--   and client functions. See <https://haskell-servant.readthedocs.io/en/stable/cookbook/structuring-apis/StructuringApis.html#structuring-apis this cookbook recipe>+--   (particularly the notes on @FactoringAPI@) for more about \"nested types\".+--+--   To derive \"flat\" client functions for the API type above, @API@, you can do:+--+--   @+--   getfoobar ':<|>' postfoobar ':<|>' getfoo ':<|>' getstrings+--     = 'client' $ 'flatten' ('Proxy' :: 'Proxy' API)+--   @+--+--   To serve an implementation for that API with \"flat\" handler types, you can do:+--+--   @+--   -- we define all our handlers assuming all the arguments are distributed,+--   -- and declare that this is an implementation for @Flat API@, not @API@.+--   server :: Server ('Flat' API)+--   server = (\foo bar -> return $ show (foo + bar))+--       ':<|>' (\foo bar body -> return $ show (foo + bar - body^2))+--       ':<|>' (\foo -> return (foo * 2))+--       ':<|>' (return ["hello", "world"])+--+--   api :: 'Proxy' API+--   api = 'Proxy'+--+--   main :: 'IO' ()+--   main = Network.Wai.Handler.Warp.run 8080 $+--     serve ('flatten' api) server+--   @+flatten :: Proxy api -> Proxy (Flat api)+flatten Proxy = Proxy++-- | Flatten and transform the API type a little bit.+type Flat api = Reassoc (Flatten (Reassoc (Flatten api)))+-- looks like Flatten/Reassoc are missing some opportunities the first time,+-- so we apply them twice for now...++-- | Completely flattens an API type by applying a few simple transformations.+--   The goal is to end up with an API type where things like @a ':>' (b ':<|>' c)@+--   are rewritten to @a ':>' b ':<|>' a ':>' c@, so as to have client with very simple+--   types, instead of "nested clients".+type family Flatten (api :: k) :: k where+  Flatten ((a :: k) :> (b :<|> c)) = Flatten (a :> b) :<|> Flatten (a :> c)+  Flatten ((a :: k) :> b)          = Redex b (Flatten b) a+  Flatten (a :<|> b)               = Flatten a :<|> Flatten b+  Flatten (a :: k)                 = a++type family Redex a b (c :: k) :: * where+  Redex a a first = Flatten first :> a+  Redex a b first = Flatten (first :> b)++-- | Reassociates '(:<|>)' to the right.+type family Reassoc api where+  Reassoc ((a :<|> b) :<|> c) = Reassoc a :<|> Reassoc (b :<|> c)+  Reassoc (a :<|> b) = a :<|> Reassoc b+  Reassoc a = a++-- * Utilities that we can define on a flat representation++-- | Get the endpoints with given indices in the all-flat+--   representation of the API type, glueing them together+--   with ':<|>'.+type family Nths (idxs :: [Nat]) api where+  Nths  '[i]      api = Nth i api+  Nths  (i ': is) api = Nth i api :<|> Nths is api++-- | Get the endpoint with given index in the all-flat representation+--   of the API type.+type family Nth (i :: Nat) api where+  Nth 0 (a :<|> b) = a+  Nth 0 a          = a+  Nth n (a :<|> b) = Nth (n - 1) b