servant-elm 0.1.0.2 → 0.2.0.0
raw patch · 17 files changed
+1055/−563 lines, 17 filesdep +directorydep +formattingdep +interpolatedep ~aesondep ~elm-exportdep ~servantnew-component:exe:books-examplenew-component:exe:e2e-tests-examplenew-component:exe:giphy-examplenew-component:exe:readme-example
Dependencies added: directory, formatting, interpolate, mockery, process
Dependency ranges changed: aeson, elm-export, servant, servant-foreign
Files
- CHANGELOG.md +12/−0
- README.md +34/−57
- examples/books/generate.hs +36/−0
- examples/e2e-tests/generate.hs +80/−0
- examples/giphy/generate.hs +62/−0
- examples/readme-example/generate.hs +29/−0
- servant-elm.cabal +73/−10
- src/Servant/Elm.hs +8/−6
- src/Servant/Elm/Client.hs +0/−159
- src/Servant/Elm/Generate.hs +0/−190
- src/Servant/Elm/Internal/Foreign.hs +27/−0
- src/Servant/Elm/Internal/Generate.hs +506/−0
- src/Servant/Elm/Internal/Orphans.hs +14/−0
- src/Servant/Elm/Request.hs +0/−82
- test/CompileSpec.hs +96/−0
- test/GenerateSpec.hs +77/−0
- test/Spec.hs +1/−59
CHANGELOG.md view
@@ -1,3 +1,15 @@+0.2.0.0+-------+* Use Text throughout the API.+* We no longer auto-generate Elm sources for the types, encoders and decoders+ used in your API - you must now use `elm-export`'s `toElmTypeSource` functions+ explicitly. See the tests and examples for usage.+* Allow setting options to pass to `elm-export`.+* Update to `servant-0.8` (purcell).+* Basic support for custom headers.+* Fix: `String` query params were being wrapped in double-quotes.+* Test: verify that the generated code can be compiled by Elm (soenkehahn)+ 0.1.0.2 ------- * Fix for API endpoints that return Unit (kantp)
README.md view
@@ -8,46 +8,24 @@ ## Installation -Until `elm-export` and `servant >= 0.5` are released, `servant-elm` requires-stack. Add this to your `stack.yaml` file:--```yaml-...-packages:- ...-- location:- git: https://github.com/haskell-servant/servant.git- commit: 761443fffecbe83aa408d5f705dd0a8dade08af9- subdirs:- - servant- - servant-foreign- - servant-server- extra-dep: True-- location:- git: https://www.github.com/mattjbray/elm-export- commit: a8a5b61798fbb04e081f5c83cab76ceaabc5ba13- extra-dep: True-- location:- git: https://www.github.com/mattjbray/servant-elm- commit: 749e09ed9d623284b3b90d1ae1ccba7ae79ad381- extra-dep: True-...-```+Servant Elm is [available on Hackage](http://hackage.haskell.org/package/servant-elm). ## Example -Let's get some language pragmas and imports out of the way.+First, some language pragmas and imports. ```haskell-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-} +import Elm (Spec (Spec), specsToDir, toElmDecoderSource,+ toElmTypeSource) import GHC.Generics (Generic) import Servant.API ((:>), Capture, Get, JSON)-import Servant.Elm (Proxy (Proxy), Spec (Spec), ToElmType,- defElmImports, generateElmForAPI, specsToDir,- specsToDir)+import Servant.Elm (ElmType, Proxy (Proxy), defElmImports,+ generateElmForAPI) ``` We have some Haskell-defined types and our Servant API.@@ -57,7 +35,7 @@ { name :: String } deriving (Generic) -instance ToElmType Book+instance ElmType Book type BooksApi = "books" :> Capture "bookId" Int :> Get '[JSON] Book ```@@ -68,7 +46,9 @@ spec :: Spec spec = Spec ["Generated", "MyApi"] (defElmImports- : generateElmForAPI (Proxy :: Proxy BooksApi))+ : toElmTypeSource (Proxy :: Proxy Book)+ : toElmDecoderSource (Proxy :: Proxy Book)+ : generateElmForAPI (Proxy :: Proxy BooksApi)) main :: IO () main = specsToDir [spec] "my-elm-dir"@@ -85,10 +65,10 @@ Here's what was generated: ```elm-module Generated.MyApi where+module Generated.MyApi exposing (..) -import Json.Decode exposing ((:=))-import Json.Decode.Extra exposing ((|:))+import Json.Decode exposing (..)+import Json.Decode.Pipeline exposing (..) import Json.Encode import Http import String@@ -96,16 +76,16 @@ type alias Book =- { name : String- }+ { name : String+ } -decodeBook : Json.Decode.Decoder Book+decodeBook : Decoder Book decodeBook =- Json.Decode.succeed Book- |: ("name" := Json.Decode.string)+ decode Book+ |> required "name" string -getBooksBy : Int -> Task.Task Http.Error (Book)-getBooksBy bookId =+getBooksByBookId : Int -> Task.Task Http.Error (Book)+getBooksByBookId bookId = let request = { verb =@@ -133,22 +113,19 @@ ``` $ git clone https://github.com/mattjbray/servant-elm.git $ cd servant-elm-$ stack build $ stack test ``` -## TODO--Servant API coverage:+To build all examples: -* MatrixFlag / MatrixParam / MatrixParams-* Header (request)-* Headers (response)-* Delete / Patch / Put / Raw-* Vault / RemoteHost / IsSecure+```+$ make examples+``` -Other:+To run an example: -* Encode captures and query params?-* Option to not use elm-export: generate functions that take a decoder and- String arguments.+```+$ cd examples/e2e-tests+$ elm-reactor+# Open http://localhost:8000/elm/Main.elm+```
+ examples/books/generate.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}++import Elm (Spec (Spec), specsToDir, toElmDecoderSource,+ toElmEncoderSource, toElmTypeSource)+import GHC.Generics (Generic)+import Servant.API ((:<|>), (:>), Capture, Get, JSON, Post, ReqBody)+import Servant.Elm (ElmOptions (..), ElmType, Proxy (Proxy),+ defElmImports, defElmOptions,+ generateElmForAPIWith)++data Book = Book+ { name :: String+ } deriving (Show, Eq, Generic)++instance ElmType Book++type BooksApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book+ :<|> "books" :> Get '[JSON] [Book]+ :<|> "books" :> Capture "bookId" Int :> Get '[JSON] Book++myElmOpts :: ElmOptions+myElmOpts = defElmOptions { urlPrefix = "http://localhost:8000" }++spec :: Spec+spec = Spec ["Generated", "BooksApi"]+ (defElmImports+ : toElmTypeSource (Proxy :: Proxy Book)+ : toElmDecoderSource (Proxy :: Proxy Book)+ : toElmEncoderSource (Proxy :: Proxy Book)+ : generateElmForAPIWith myElmOpts (Proxy :: Proxy BooksApi))++main :: IO ()+main = specsToDir [spec] "elm"
+ examples/e2e-tests/generate.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}++import Elm (Spec (Spec), specsToDir, toElmDecoderSource,+ toElmEncoderSource, toElmTypeSource)+import GHC.Generics (Generic)+import Servant.API ((:<|>), (:>), Capture, Get, GetNoContent, JSON,+ NoContent, Post, QueryParam, ReqBody)+import Servant.Elm (ElmOptions (..), ElmType, Proxy (Proxy),+ defElmImports, defElmOptions,+ generateElmForAPIWith)+++myElmOpts :: ElmOptions+myElmOpts = defElmOptions { urlPrefix = "https://httpbin.org" }+++data MessageBody = MessageBody+ { message :: String }+ deriving (Generic, ElmType)++data QueryArgs = QueryArgs+ { q :: String }+ deriving (Generic, ElmType)++data Response = Response+ { origin :: String }+ deriving (Generic, ElmType)++data ResponseWithJson = ResponseWithJson+ { json :: MessageBody }+ deriving (Generic, ElmType)++data ResponseWithArgs = ResponseWithArgs+ { args :: QueryArgs }+ deriving (Generic, ElmType)+++type Api+ = "ip"+ :> Get '[JSON] Response+ :<|> "status"+ :> "204"+ :> GetNoContent '[JSON] NoContent+ :<|> "post"+ :> ReqBody '[JSON] MessageBody+ :> Post '[JSON] ResponseWithJson+ :<|> "get"+ :> QueryParam "q" String+ :> Get '[JSON] ResponseWithArgs+ :<|> Capture "path" String+ :> Get '[JSON] Response+++spec :: Spec+spec =+ Spec ["Generated", "Api"]+ (defElmImports+ : toElmTypeSource (Proxy :: Proxy Response)+ : toElmDecoderSource (Proxy :: Proxy Response)+ : toElmTypeSource (Proxy :: Proxy NoContent)+ : toElmTypeSource (Proxy :: Proxy MessageBody)+ : toElmEncoderSource (Proxy :: Proxy MessageBody)+ : toElmDecoderSource (Proxy :: Proxy MessageBody)+ : toElmTypeSource (Proxy :: Proxy ResponseWithJson)+ : toElmDecoderSource (Proxy :: Proxy ResponseWithJson)+ : toElmTypeSource (Proxy :: Proxy QueryArgs)+ : toElmDecoderSource (Proxy :: Proxy QueryArgs)+ : toElmTypeSource (Proxy :: Proxy ResponseWithArgs)+ : toElmDecoderSource (Proxy :: Proxy ResponseWithArgs)+ : generateElmForAPIWith+ myElmOpts+ (Proxy :: Proxy Api))+++main :: IO ()+main = specsToDir [spec] "elm"
+ examples/giphy/generate.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}++import qualified Data.Text as T+import Elm (Options, Spec (Spec), defaultOptions,+ fieldLabelModifier, specsToDir,+ toElmDecoderSourceWith, toElmTypeSourceWith)+import GHC.Generics (Generic)+import Servant.API ((:>), Get, JSON, QueryParam)+import Servant.Elm (ElmOptions (..), ElmType, Proxy (Proxy),+ defElmImports, defElmOptions,+ generateElmForAPIWith)++data GifData = GifData+ { image_url :: String+ } deriving (Show, Eq, Generic)++data Gif = Gif+ { _data :: GifData+ } deriving (Show, Eq, Generic)++instance ElmType GifData+instance ElmType Gif++stripUnderscore :: T.Text -> T.Text+stripUnderscore field =+ if T.head field == '_' then+ T.tail field+ else+ field++options :: Elm.Options+options =+ Elm.defaultOptions+ { Elm.fieldLabelModifier = stripUnderscore }++myElmOpts :: ElmOptions+myElmOpts =+ defElmOptions+ { urlPrefix =+ "http://api.giphy.com/v1/gifs"+ , elmExportOptions =+ options+ }++type GiphyApi = "random" :> QueryParam "api_key" String :> QueryParam "tag" String :> Get '[JSON] Gif++giphySpec :: Spec+giphySpec = Spec ["Generated", "GiphyApi"]+ (defElmImports+ : toElmTypeSourceWith options (Proxy :: Proxy Gif)+ : toElmTypeSourceWith options (Proxy :: Proxy GifData)+ : toElmDecoderSourceWith options (Proxy :: Proxy Gif)+ : toElmDecoderSourceWith options (Proxy :: Proxy GifData)+ : generateElmForAPIWith+ myElmOpts+ (Proxy :: Proxy GiphyApi))++main :: IO ()+main = specsToDir [giphySpec] "elm"
+ examples/readme-example/generate.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}++import Elm (Spec (Spec), specsToDir, toElmDecoderSource,+ toElmTypeSource)+import GHC.Generics (Generic)+import Servant.API ((:>), Capture, Get, JSON)+import Servant.Elm (ElmType, Proxy (Proxy), defElmImports,+ generateElmForAPI)++data Book = Book+ { name :: String+ } deriving (Generic)++instance ElmType Book++type BooksApi = "books" :> Capture "bookId" Int :> Get '[JSON] Book++spec :: Spec+spec = Spec ["Generated", "MyApi"]+ (defElmImports+ : toElmTypeSource (Proxy :: Proxy Book)+ : toElmDecoderSource (Proxy :: Proxy Book)+ : generateElmForAPI (Proxy :: Proxy BooksApi))++main :: IO ()+main = specsToDir [spec] "my-elm-dir"
servant-elm.cabal view
@@ -1,5 +1,5 @@ name: servant-elm-version: 0.1.0.2+version: 0.2.0.0 synopsis: Automatically derive Elm functions to query servant webservices. description: Please see README.md homepage: http://github.com/mattjbray/servant-elm#readme@@ -15,34 +15,97 @@ README.md cabal-version: >=1.10 +flag examples+ Description: Build the example programs.+ Default: False+ library hs-source-dirs: src exposed-modules: Servant.Elm- other-modules: Servant.Elm.Client- , Servant.Elm.Generate- , Servant.Elm.Request+ , Servant.Elm.Internal.Foreign+ , Servant.Elm.Internal.Generate+ , Servant.Elm.Internal.Orphans build-depends: base >= 4.7 && < 5+ , elm-export >= 0.5+ , formatting , lens- , servant == 0.5.*- , servant-foreign == 0.5.*+ , servant >= 0.8+ , servant-foreign >= 0.8 , text- , elm-export+ ghc-options: -Wall default-language: Haskell2010 test-suite servant-elm-test type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs- build-depends: aeson+ other-modules: CompileSpec+ , GenerateSpec+ build-depends: aeson >= 0.9 , base , data-default- , elm-export+ , directory+ , elm-export >= 0.5+ , formatting , hspec+ , interpolate+ , mockery+ , process , servant , servant-elm- ghc-options: -threaded -rtsopts -with-rtsopts=-N+ , text+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall default-language: Haskell2010 source-repository head type: git location: https://github.com/mattjbray/servant-elm++executable books-example+ if !flag(examples)+ Buildable: False+ main-is: generate.hs+ build-depends: base >= 4.7 && < 5+ , elm-export >= 0.5+ , servant >= 0.8+ , servant-elm+ hs-source-dirs: examples/books+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++executable e2e-tests-example+ if !flag(examples)+ Buildable: False+ main-is: generate.hs+ build-depends: base >= 4.7 && < 5+ , elm-export >= 0.5+ , servant >= 0.8+ , servant-elm+ hs-source-dirs: examples/e2e-tests+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++executable giphy-example+ if !flag(examples)+ Buildable: False+ main-is: generate.hs+ build-depends: base >= 4.7 && < 5+ , elm-export >= 0.5+ , servant >= 0.8+ , servant-elm+ , text+ hs-source-dirs: examples/giphy+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++executable readme-example+ if !flag(examples)+ Buildable: False+ main-is: generate.hs+ build-depends: base >= 4.7 && < 5+ , elm-export >= 0.5+ , servant >= 0.8+ , servant-elm+ hs-source-dirs: examples/readme-example+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010
src/Servant/Elm.hs view
@@ -19,15 +19,17 @@ , defElmImports -- * Convenience re-exports from the "Elm" module , Spec(Spec)- , ToElmType+ , ElmType , specsToDir -- * Convenience re-exports from "Data.Proxy" , Proxy(Proxy) ) where -import Servant.Elm.Generate (ElmOptions (..), defElmImports,- defElmOptions, generateElmForAPI,- generateElmForAPIWith)+import Servant.Elm.Internal.Generate (ElmOptions (..), defElmImports,+ defElmOptions,+ generateElmForAPI,+ generateElmForAPIWith) -import Data.Proxy (Proxy(Proxy))-import Elm (Spec(Spec), ToElmType, specsToDir)+import Data.Proxy (Proxy (Proxy))+import Elm (ElmType, Spec (Spec),+ specsToDir)
− src/Servant/Elm/Client.hs
@@ -1,159 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators #-}--module Servant.Elm.Client where--import Data.Proxy (Proxy (Proxy))-import qualified Data.Text as T-import Elm (ToElmType, toElmDecoderWithSources,- toElmEncoderWithSources,- toElmTypeWithSources)-import GHC.TypeLits (KnownSymbol, symbolVal)-import Servant.API ((:<|>), (:>), Capture, Get, Post,- QueryFlag, QueryParam, QueryParams,- ReqBody)-import Servant.Foreign (ArgType (..), QueryArg (..), Segment (..),- SegmentType (..))--import Servant.Elm.Request (Request (..), addArgName, addDecoderDefs,- addEncoderDefs, addFnName, addFnSignature,- addTypeDefs, addUrlQueryStr,- addUrlSegment, defRequest, setBodyEncoder,- setDecoder, setHttpMethod)---elmClient :: (HasElmClient layout)- => Proxy layout -> [Request]-elmClient p = elmClientWithRoute p defRequest---class HasElmClient layout where- elmClientWithRoute :: Proxy layout -> Request -> [Request]----- a :<|> b-instance (HasElmClient a, HasElmClient b) => HasElmClient (a :<|> b) where- elmClientWithRoute Proxy result =- elmClientWithRoute (Proxy :: Proxy a) result ++- elmClientWithRoute (Proxy :: Proxy b) result----- path :> rest-instance (KnownSymbol path, HasElmClient sublayout) => HasElmClient (path :> sublayout) where- elmClientWithRoute Proxy result =- elmClientWithRoute (Proxy :: Proxy sublayout)- ((addFnName p . addUrlSegment segment) result)- where p = symbolVal (Proxy :: Proxy path)- segment = Segment (Static (T.pack p))----- Capture name ArgType :> rest-instance (KnownSymbol capture, ToElmType a, HasElmClient sublayout)- => HasElmClient (Capture capture a :> sublayout) where- elmClientWithRoute Proxy result =- elmClientWithRoute (Proxy :: Proxy sublayout)- ((addTypeDefs tDefs- . addFnSignature typeName- . addFnName "by"- . addArgName argName- . addUrlSegment (Segment (Cap (T.pack argName, T.pack typeName)))) result)- where argProxy = Proxy :: Proxy a- argName = symbolVal (Proxy :: Proxy capture)- (typeName, tDefs) = toElmTypeWithSources argProxy----- QueryFlag name :> rest-instance (KnownSymbol sym, HasElmClient sublayout)- => HasElmClient (QueryFlag sym :> sublayout) where- elmClientWithRoute Proxy result =- elmClientWithRoute (Proxy :: Proxy sublayout)- ((addArgName argName- . addFnSignature typeName- . addUrlQueryStr (QueryArg (T.pack argName, T.pack typeName) Flag)) result)- where argName = symbolVal (Proxy :: Proxy sym)- (typeName, _) = toElmTypeWithSources (Proxy :: Proxy Bool)----- QueryParams name ArgType :> rest-instance (KnownSymbol sym, ToElmType a, HasElmClient sublayout)- => HasElmClient (QueryParams sym a :> sublayout) where- elmClientWithRoute Proxy result =- elmClientWithRoute (Proxy :: Proxy sublayout)- ((addArgName argName- . addTypeDefs tDefs- . addFnSignature typeName- . addUrlQueryStr (QueryArg (T.pack argName, T.pack typeName) List)) result)- where argName = symbolVal (Proxy :: Proxy sym)- (typeName, tDefs) = toElmTypeWithSources (Proxy :: Proxy [a])----- QueryParam name ArgType :> rest-instance (KnownSymbol sym, ToElmType a, HasElmClient sublayout)- => HasElmClient (QueryParam sym a :> sublayout) where- elmClientWithRoute Proxy result =- elmClientWithRoute (Proxy :: Proxy sublayout)- ((addArgName argName- . addTypeDefs tDefs- . addFnSignature typeName- . addUrlQueryStr (QueryArg (T.pack argName, T.pack typeName) Normal)) result)- where argName = symbolVal (Proxy :: Proxy sym)- (typeName, tDefs) = toElmTypeWithSources (Proxy :: Proxy (Maybe a))----- ReqBody '[cts] BodyType :> rest-instance (ToElmType body, HasElmClient sublayout)- => HasElmClient (ReqBody (ct ': cts) body :> sublayout) where- elmClientWithRoute Proxy request =- elmClientWithRoute (Proxy :: Proxy sublayout)- ((addArgName "body"- . addTypeDefs typeDefs- . addFnSignature typeName- . setBodyEncoder bodyEncoder- . addEncoderDefs encoderDefs) request)- where (typeName, typeDefs) = toElmTypeWithSources (Proxy :: Proxy body)- (bodyEncoder, encoderDefs) = toElmEncoderWithSources (Proxy :: Proxy body)----- Get '[cts] RequestType-instance {-# OVERLAPPABLE #-} (ToElmType apiRequest) => HasElmClient (Get (ct ': cts) apiRequest) where- elmClientWithRoute Proxy request =- [completeRequestWithType (Proxy :: Proxy apiRequest) "GET" request]----- Get '[cts] ()-instance {-# OVERLAPPING #-} HasElmClient (Get (ct ': cts) ()) where- elmClientWithRoute Proxy request =- [completeRequest "GET" request]----- Post '[cts] RequestType-instance {-# OVERLAPPABLE #-} (ToElmType apiRequest) => HasElmClient (Post (ct ': cts) apiRequest) where- elmClientWithRoute Proxy request =- [completeRequestWithType (Proxy :: Proxy apiRequest) "POST" request]----- Post '[cts] ()-instance {-# OVERLAPPING #-} HasElmClient (Post (ct ': cts) ()) where- elmClientWithRoute Proxy request =- [completeRequest "POST" request]---completeRequestWithType :: ToElmType a => Proxy a -> String -> Request -> Request-completeRequestWithType proxy method =- setHttpMethod method- . addFnSignature typeName- . addTypeDefs typeDefs- . addDecoderDefs decDefs- . setDecoder dec- where- (dec, decDefs) = toElmDecoderWithSources proxy- (typeName, typeDefs) = toElmTypeWithSources proxy---completeRequest :: String -> Request -> Request-completeRequest method =- setHttpMethod method- . addFnSignature "()"- . setDecoder "(Json.Decode.succeed ())"
− src/Servant/Elm/Generate.hs
@@ -1,190 +0,0 @@-module Servant.Elm.Generate where--import Data.Char (toLower)-import Data.List (intercalate, nub)-import Data.Maybe (catMaybes)-import Data.Proxy (Proxy)-import qualified Data.Text as T-import Servant.Elm.Client (HasElmClient, elmClient)-import Servant.Elm.Request (Request (..))-import Servant.Foreign (ArgType (..), QueryArg (..), Segment (..),- SegmentType (..), camelCase)---{-|-Options to configure how code is generated.--}-data ElmOptions = ElmOptions- { {- | The protocol, host and any path prefix to be used as the base for all- requests.-- Example: @"https://mydomain.com/api/v1"@- -}- urlPrefix :: String }---{-|-The default options for generating Elm code.--[@urlPrefix@] (An empty string)--}-defElmOptions :: ElmOptions-defElmOptions = ElmOptions- { urlPrefix = "" }---{-|-Default imports required by generated Elm code.--You probably want to include this at the top of your generated Elm module.--The default required imports are:--> import Json.Decode exposing ((:=))-> import Json.Decode.Extra exposing ((|:))-> import Json.Encode-> import Http-> import String-> import Task--}-defElmImports :: String-defElmImports =- unlines- [ "import Json.Decode exposing ((:=))"- , "import Json.Decode.Extra exposing ((|:))"- , "import Json.Encode"- , "import Http"- , "import String"- , "import Task"- ]---{-|-Generate Elm code for the API with default options.--Returns a list of Elm code definitions with everything you need to query your-Servant API from Elm: type definitions, JSON decoders, JSON encoders, and query-functions.--You could spit these out to a file and call them from your Elm code, but you-would be better off creating a 'Spec' with the result and using 'specsToDir',-which handles the module name for you.--}-generateElmForAPI :: (HasElmClient layout)- => Proxy layout -> [String]-generateElmForAPI = generateElmForAPIWith defElmOptions---{-|-Generate Elm code for the API with custom options.--}-generateElmForAPIWith :: (HasElmClient layout)- => ElmOptions -> Proxy layout -> [String]-generateElmForAPIWith opts = nub . concatMap (generateElmForRequest opts) . elmClient----- TODO: headers, content type?, url encoders?-generateElmForRequest :: ElmOptions -> Request -> [String]-generateElmForRequest opts request = typeDefs request ++ decoderDefs request ++ encoderDefs request ++ [func]- where func = funcName ++ " : " ++ (typeSignature . reverse . fnSignature) request ++ "\n"- ++ funcNameArgs ++ " =\n"- ++ " let\n"- ++ letParams " "- ++ " request =\n"- ++ " { verb =\n"- ++ " \"" ++ httpMethod request ++ "\"\n"- ++ " , headers =\n"- ++ " [(\"Content-Type\", \"application/json\")]\n"- ++ " , url =\n"- ++ " " ++ url ++ "\n"- ++ urlParams " "- ++ " , body =\n"- ++ " " ++ body ++ "\n"- ++ " }\n"- ++ " in\n"- ++ " Http.fromJson\n"- ++ " " ++ decoder request ++ "\n"- ++ " (Http.send Http.defaultSettings request)"- funcName = (T.unpack . camelCase . map T.pack . (:) (map toLower (httpMethod request)) . reverse) (fnName request)- typeSignature [x] = "Task.Task Http.Error (" ++ x ++ ")"- typeSignature (x:xs) = x ++ " -> " ++ typeSignature xs- typeSignature [] = ""- funcNameArgs = unwords (funcName : args)- url = buildUrl (urlPrefix opts) segments- args = reverse (argNames request)- segments = (reverse . urlSegments) request- params = (map paramToStr . reverse . urlQueryStr) request- letParams indent =- if null params then- ""- else- indent- ++ intercalate ("\n" ++ indent)- [ "params ="- , " List.filter (not << String.isEmpty)"- , " [ " ++ intercalate ("\n" ++ indent ++ " , ") params- , " ]"- ]- ++ "\n"- urlParams indent =- if null params then- ""- else- indent- ++ intercalate ("\n" ++ indent)- [ "++ if List.isEmpty params then"- , " \"\""- , " else"- , " \"?\" ++ String.join \"&\" params"- ]- ++ "\n"- body = case bodyEncoder request of- Just encoder -> "Http.string (Json.Encode.encode 0 (" ++ encoder ++ " body))"- Nothing -> "Http.empty"---buildUrl :: String -> [Segment] -> String-buildUrl prefix segments =- (intercalate newLine . catMaybes)- [ nullOr prefix $- "\"" ++ prefix ++ "\""- , nullOr segments $- "\"/\" ++ "- ++ intercalate (newLine ++ "\"/\" ++ ")- (map segmentToStr segments)- ]- where newLine = "\n ++ "- nullOr t x = if null t- then Nothing- else Just x---segmentToStr :: Segment -> String-segmentToStr (Segment (Static s)) = "\"" ++ T.unpack s ++ "\""-segmentToStr (Segment (Cap (s, _))) = "(" ++ T.unpack s ++ " |> toString |> Http.uriEncode)"---paramToStr :: QueryArg -> String-paramToStr qarg =- case _argType qarg of- Normal ->- intercalate newLine- [ name- , " |> Maybe.map (toString >> Http.uriEncode >> (++) \"" ++ name ++ "=\")"- , " |> Maybe.withDefault \"\""- ]- Flag ->- intercalate newLine- ["if " ++ name ++ " then"- , " \"" ++ name ++ "=\""- , "else"- , " \"\""- ]- List ->- intercalate newLine- [ name- , " |> List.map (\\val -> \"" ++ name ++ "[]=\" ++ (val |> toString |> Http.uriEncode))"- , " |> String.join \"&\""- ]- where name = T.unpack (fst (_argName qarg))- newLine = "\n "
+ src/Servant/Elm/Internal/Foreign.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}++module Servant.Elm.Internal.Foreign where++import Data.Proxy (Proxy (Proxy))+import Elm (ElmDatatype, ElmType, toElmType)+import Servant.Foreign (Foreign, GenerateList, HasForeign,+ HasForeignType, Req, listFromAPI, typeFor)+++data LangElm++instance (ElmType a) => HasForeignType LangElm ElmDatatype a where+ typeFor _ _ _ =+ toElmType (Proxy :: Proxy a)++getEndpoints+ :: ( HasForeign LangElm ElmDatatype api+ , GenerateList ElmDatatype (Foreign ElmDatatype api))+ => Proxy api+ -> [Req ElmDatatype]+getEndpoints =+ listFromAPI (Proxy :: Proxy LangElm) (Proxy :: Proxy ElmDatatype)
+ src/Servant/Elm/Internal/Generate.hs view
@@ -0,0 +1,506 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+module Servant.Elm.Internal.Generate where++import Control.Lens (to, view, (^.))+import Data.List (nub)+import Data.Maybe (catMaybes)+import Data.Monoid ((<>))+import Data.Proxy (Proxy)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Elm (ElmDatatype)+import qualified Elm+import Formatting (sformat, stext, (%))+import Servant.API (NoContent (..))+import Servant.Elm.Internal.Foreign (LangElm, getEndpoints)+import Servant.Elm.Internal.Orphans ()+import qualified Servant.Foreign as F+++{-|+Options to configure how code is generated.+-}+data ElmOptions = ElmOptions+ { {- | The protocol, host and any path prefix to be used as the base for all+ requests.++ Example: @"https://mydomain.com/api/v1"@+ -}+ urlPrefix :: T.Text+ , elmExportOptions :: Elm.Options+ -- ^ Options to pass to elm-export+ , emptyResponseElmTypes :: [ElmDatatype]+ -- ^ Types that represent an empty Http response.+ , stringElmTypes :: [ElmDatatype]+ -- ^ Types that represent a String.+ }+++{-|+Default options for generating Elm code.++The default options are:++> { urlPrefix =+> ""+> , elmExportOptions =+> Elm.defaultOptions+> , emptyResponseElmTypes =+> [ toElmType NoContent ]+> , stringElmTypes =+> [ toElmType "" ]+> }+-}+defElmOptions :: ElmOptions+defElmOptions = ElmOptions+ { urlPrefix = ""+ , elmExportOptions = Elm.defaultOptions+ , emptyResponseElmTypes =+ [ Elm.toElmType NoContent+ , Elm.toElmType ()+ ]+ , stringElmTypes =+ [ Elm.toElmType ("" :: String)+ ]+ }+++{-|+Default imports required by generated Elm code.++You probably want to include this at the top of your generated Elm module.++The default required imports are:++> import Json.Decode exposing (..)+> import Json.Decode.Pipeline exposing (..)+> import Json.Encode+> import Http+> import String+> import Task+-}+defElmImports :: Text+defElmImports =+ T.unlines+ [ "import Json.Decode exposing (..)"+ , "import Json.Decode.Pipeline exposing (..)"+ , "import Json.Encode"+ , "import Http"+ , "import String"+ , "import Task"+ ]+++{-|+Generate Elm code for the API with default options.++Returns a list of Elm functions to query your Servant API from Elm.++You could spit these out to a file and call them from your Elm code, but you+would be better off creating a 'Spec' with the result and using 'specsToDir',+which handles the module name for you.+-}+generateElmForAPI+ :: ( F.HasForeign LangElm ElmDatatype api+ , F.GenerateList ElmDatatype (F.Foreign ElmDatatype api))+ => Proxy api+ -> [Text]+generateElmForAPI =+ generateElmForAPIWith defElmOptions+++{-|+Generate Elm code for the API with custom options.+-}+generateElmForAPIWith+ :: ( F.HasForeign LangElm ElmDatatype api+ , F.GenerateList ElmDatatype (F.Foreign ElmDatatype api))+ => ElmOptions+ -> Proxy api+ -> [Text]+generateElmForAPIWith opts =+ nub . concatMap (generateElmForRequest opts) . getEndpoints++cr :: Text+cr = "\n"++quote :: Text+quote = "\""++inQuotes :: Text -> Text+inQuotes s = quote <> s <> quote++{-|+Generate an Elm function for one endpoint.++This function returns a list because the query function may require some+supporting definitions.+-}+generateElmForRequest :: ElmOptions -> F.Req ElmDatatype -> [Text]+generateElmForRequest opts request =+ supportingFunctions+ ++ [funcDef]+ where+ funcDef =+ fnName <> " : " <> typeSignature <> cr <>+ T.unwords (fnName : args) <> " =" <> cr <>+ " let" <> cr <>+ (maybe "" (<> cr) letParams) <>+ letRequest <> cr <>+ " in" <> cr <>+ httpRequest++ fnName =+ request ^. F.reqFuncName . to F.camelCase++ typeSignature =+ mkTypeSignature opts request++ args =+ mkArgsList request++ letParams =+ mkLetParams " " opts request++ letRequest =+ mkLetRequest " " opts request++ (httpRequest, supportingFunctions) =+ mkHttpRequest " " opts request+++mkTypeSignature+ :: ElmOptions+ -> F.Req ElmDatatype+ -> Text+mkTypeSignature opts request =+ T.intercalate " -> "+ ( headerTypes+ ++ urlCaptureTypes+ ++ queryTypes+ ++ catMaybes [bodyType, returnType])+ where+ elmTypeRef :: ElmDatatype -> Text+ elmTypeRef eType =+ Elm.toElmTypeRefWith (elmExportOptions opts) eType++ headerTypes :: [Text]+ headerTypes =+ [ header ^. F.headerArg . F.argType . to elmTypeRef+ | header <- request ^. F.reqHeaders+ ]++ urlCaptureTypes :: [Text]+ urlCaptureTypes =+ [ F.captureArg capture ^. F.argType . to elmTypeRef+ | capture <- request ^. F.reqUrl . F.path+ , F.isCapture capture+ ]++ queryTypes :: [Text]+ queryTypes =+ [ arg ^. F.queryArgName . F.argType . to (elmTypeRef . wrapper)+ | arg <- request ^. F.reqUrl . F.queryStr+ , wrapper <- [+ case arg ^. F.queryArgType of+ F.Normal ->+ Elm.ElmPrimitive . Elm.EMaybe+ _ ->+ id+ ]+ ]++ bodyType :: Maybe Text+ bodyType =+ elmTypeRef <$> request ^. F.reqBody++ returnType :: Maybe Text+ returnType =+ sformat ("Task.Task Http.Error (" % stext % ")") . elmTypeRef <$> request ^. F.reqReturnType+++mkArgsList+ :: F.Req ElmDatatype+ -> [Text]+mkArgsList request =+ -- Headers+ [ header ^. F.headerArg . F.argName . to F.unPathSegment+ | header <- request ^. F.reqHeaders+ ]+ +++ -- URL Captures+ [ F.captureArg segment ^. F.argName . to F.unPathSegment+ | segment <- request ^. F.reqUrl . F.path+ , F.isCapture segment+ ]+ +++ -- Query params+ [ arg ^. F.queryArgName . F.argName . to F.unPathSegment+ | arg <- request ^. F.reqUrl . F.queryStr+ ]+ +++ -- Request body+ maybe [] (const ["body"]) (request ^. F.reqBody)+++mkUrl+ :: Text+ -> ElmOptions+ -> [F.Segment ElmDatatype]+ -> Text+mkUrl indent opts segments =+ (T.intercalate newLine . catMaybes)+ [ if T.null (urlPrefix opts) then+ Nothing+ else+ Just $ inQuotes (urlPrefix opts)+ , if null segments then+ Nothing+ else+ Just $ inQuotes "/" <> " ++ "+ <> T.intercalate (newLine <> inQuotes "/" <> " ++ ")+ (map segmentToText segments)+ ]+ where+ newLine =+ cr <> indent <> "++ "++ segmentToText :: F.Segment ElmDatatype -> Text+ segmentToText s =+ case F.unSegment s of+ F.Static path ->+ "\"" <> F.unPathSegment path <> "\""+ F.Cap arg ->+ let+ -- Don't use "toString" on Elm Strings, otherwise we get extraneous quotes.+ toStringSrc =+ if isElmStringType opts (arg ^. F.argType) then+ ""+ else+ " |> toString"+ in+ "(" <> (F.unPathSegment (arg ^. F.argName)) <> toStringSrc <> " |> Http.uriEncode)"+++mkLetParams+ :: Text+ -> ElmOptions+ -> F.Req ElmDatatype+ -> Maybe Text+mkLetParams indent opts request =+ if null (request ^. F.reqUrl . F.queryStr) then+ Nothing+ else+ Just $ T.intercalate "\n" $ map (indent <>)+ [ "params ="+ , " List.filter (not << String.isEmpty)"+ , " [ " <> T.intercalate ("\n" <> indent <> " , ") params+ , " ]"+ ]+ where+ params :: [Text]+ params = map paramToStr (request ^. F.reqUrl . F.queryStr)++ paramToStr :: F.QueryArg ElmDatatype -> Text+ paramToStr qarg =+ case qarg ^. F.queryArgType of+ F.Normal ->+ let+ -- Don't use "toString" on Elm Strings, otherwise we get extraneous quotes.+ toStringSrc =+ if isElmStringType opts (qarg ^. F.queryArgName . F.argType) then+ ""+ else+ "toString >> "+ in+ T.intercalate newLine+ [ name+ , " |> Maybe.map (" <> toStringSrc <> "Http.uriEncode >> (++) \"" <> name <> "=\")"+ , " |> Maybe.withDefault \"\""+ ]++ F.Flag ->+ T.intercalate newLine+ ["if " <> name <> " then"+ , " \"" <> name <> "=\""+ , "else"+ , " \"\""+ ]++ F.List ->+ T.intercalate newLine+ [ name+ , " |> List.map (\\val -> \"" <> name <> "[]=\" ++ (val |> toString |> Http.uriEncode))"+ , " |> String.join \"&\""+ ]+ where+ name =+ F.unPathSegment . view (F.queryArgName . F.argName) $ qarg+ newLine = "\n "+++mkLetRequest+ :: Text+ -> ElmOptions+ -> F.Req ElmDatatype+ -> Text+mkLetRequest indent opts request =+ T.intercalate "\n" $ map (indent <>)+ ([ "request ="+ , " { verb ="+ , " \"" <> method <> "\""+ , " , headers ="+ , " [(\"Content-Type\", \"application/json\")" <> headers <> "]"+ , " , url ="+ , " " <> url+ ]+ ++ mkQueryParams " " request+ ++ [ " , body ="+ , " " <> body+ , " }"+ ]+ )+ where+ method =+ T.decodeUtf8 (request ^. F.reqMethod)++ headers =+ T.concat . map ((cr <> indent <> " ,") <>) $+ ["(" <> inQuotes headerName <> ", " <>+ (if isElmStringType opts (header ^. F.headerArg . F.argType) then+ ""+ else+ "toString "+ ) <>+ headerName <> ")"+ | header <- request ^. F.reqHeaders+ , headerName <- [header ^. F.headerArg . F.argName . to F.unPathSegment]+ ]++ url =+ mkUrl (indent <> " ") opts (request ^. F.reqUrl . F.path)++ body =+ case request ^. F.reqBody of+ Nothing ->+ "Http.empty"++ Just elmTypeExpr ->+ let+ encoderName =+ Elm.toElmEncoderRefWith (elmExportOptions opts) elmTypeExpr+ in+ sformat ("Http.string (Json.Encode.encode 0 (" % stext % " body))") encoderName+++mkQueryParams+ :: Text+ -> F.Req ElmDatatype+ -> [Text]+mkQueryParams indent request =+ if null (request ^. F.reqUrl . F.queryStr) then+ []+ else+ map (indent <>)+ [ "++ if List.isEmpty params then"+ , " \"\""+ , " else"+ , " \"?\" ++ String.join \"&\" params"+ ]+++{-| If the return type has a decoder, construct the request using Http.fromJson.+Otherwise, construct an HTTP request that expects an empty response.+-}+mkHttpRequest+ :: Text+ -> ElmOptions+ -> F.Req ElmDatatype+ -> (Text, [Text])+mkHttpRequest indent opts request =+ ( T.intercalate "\n" $ map (indent <>) elmLines+ , supportingFunctions+ )+ where+ (elmLines, supportingFunctions) =+ case request ^. F.reqReturnType of+ Just elmTypeExpr | isEmptyType opts elmTypeExpr ->+ (emptyResponseRequest (Elm.toElmTypeRefWith (elmExportOptions opts) elmTypeExpr)+ , [ emptyResponseHandlerSrc+ , handleResponseSrc+ , promoteErrorSrc+ ]+ )++ Just elmTypeExpr ->+ ( jsonRequest (Elm.toElmDecoderRefWith (elmExportOptions opts) elmTypeExpr)+ , []+ )++ Nothing ->+ error "mkHttpRequest: no reqReturnType?"++ jsonRequest decoder =+ [ "Http.fromJson"+ , " " <> decoder+ , " (Http.send Http.defaultSettings request)"+ ]++ emptyResponseRequest elmType =+ [ "Task.mapError promoteError"+ , " (Http.send Http.defaultSettings request)"+ , " `Task.andThen`"+ , " handleResponse (emptyResponseHandler " <> elmType <> ")"+ ]++ emptyResponseHandlerSrc =+ T.intercalate "\n"+ [ "emptyResponseHandler : a -> String -> Task.Task Http.Error a"+ , "emptyResponseHandler x str ="+ , " if String.isEmpty str then"+ , " Task.succeed x"+ , " else"+ , " Task.fail (Http.UnexpectedPayload str)"+ ]++ handleResponseSrc =+ T.intercalate "\n"+ [ "handleResponse : (String -> Task.Task Http.Error a) -> Http.Response -> Task.Task Http.Error a"+ , "handleResponse handle response ="+ , " if 200 <= response.status && response.status < 300 then"+ , " case response.value of"+ , " Http.Text str ->"+ , " handle str"+ , " _ ->"+ , " Task.fail (Http.UnexpectedPayload \"Response body is a blob, expecting a string.\")"+ , " else"+ , " Task.fail (Http.BadResponse response.status response.statusText)"+ ]++ promoteErrorSrc =+ T.intercalate "\n"+ [ "promoteError : Http.RawError -> Http.Error"+ , "promoteError rawError ="+ , " case rawError of"+ , " Http.RawTimeout -> Http.Timeout"+ , " Http.RawNetworkError -> Http.NetworkError"+ ]+++{- | Determines whether we construct an Elm function that expects an empty+response body.+-}+isEmptyType :: ElmOptions -> ElmDatatype -> Bool+isEmptyType opts elmTypeExpr =+ elmTypeExpr `elem` emptyResponseElmTypes opts+++{- | Determines whether we call `toString` on URL captures and query params of+this type in Elm.+-}+isElmStringType :: ElmOptions -> ElmDatatype -> Bool+isElmStringType opts elmTypeExpr =+ elmTypeExpr `elem` stringElmTypes opts
+ src/Servant/Elm/Internal/Orphans.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE StandaloneDeriving #-}++module Servant.Elm.Internal.Orphans where++import Elm (ElmDatatype, ElmType, toElmType)+import Servant.API (NoContent)+++instance ElmType ElmDatatype where+ toElmType = id+++instance ElmType NoContent
− src/Servant/Elm/Request.hs
@@ -1,82 +0,0 @@-{-# LANGUAGE TypeOperators #-}--module Servant.Elm.Request where--import Servant.Foreign (QueryArg, Segment)---data Request = Request- { typeDefs :: [String]- , decoderDefs :: [String]- , encoderDefs :: [String]- , decoder :: String- , fnName :: [String]- , fnSignature :: [String]- , urlSegments :: [Segment]- , urlQueryStr :: [QueryArg]- , httpMethod :: String- , argNames :: [String]- , bodyEncoder :: Maybe String- } deriving (Show)---defRequest :: Request-defRequest = Request- { typeDefs = []- , decoderDefs = []- , encoderDefs = []- , decoder = ""- , fnName = []- , fnSignature = []- , httpMethod = "GET"- , urlSegments = []- , urlQueryStr = []- , argNames = []- , bodyEncoder = Nothing- }---addTypeDefs :: [String] -> Request -> Request-addTypeDefs elmTypes request = request { typeDefs = typeDefs request ++ elmTypes }---addFnName :: String -> Request -> Request-addFnName name request = request { fnName = name : fnName request }---addUrlSegment :: Segment -> Request -> Request-addUrlSegment segment request = request { urlSegments = segment : urlSegments request }---addUrlQueryStr :: QueryArg -> Request -> Request-addUrlQueryStr arg request = request { urlQueryStr = arg : urlQueryStr request }----- TODO: perhaps we could get rid of most of the fnSignature stuff now that--- servant-foreign allows us to keep it in their Arg type.-addFnSignature :: String -> Request -> Request-addFnSignature name request = request { fnSignature = name : fnSignature request }---setDecoder :: String -> Request -> Request-setDecoder dec request = request { decoder = dec }---addDecoderDefs :: [String] -> Request -> Request-addDecoderDefs defs request = request { decoderDefs = decoderDefs request ++ defs }---addArgName :: String -> Request -> Request-addArgName name request = request { argNames = name : argNames request }---setHttpMethod :: String -> Request -> Request-setHttpMethod method request = request { httpMethod = method }---setBodyEncoder :: String -> Request -> Request-setBodyEncoder encoder request = request { bodyEncoder = Just encoder }---addEncoderDefs :: [String] -> Request -> Request-addEncoderDefs defs request = request { encoderDefs = encoderDefs request ++ defs }
+ test/CompileSpec.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++module CompileSpec where++import Test.Hspec+import Test.Mockery.Directory++import Control.Exception+import Control.Monad (when)+import Data.String.Interpolate+import Data.String.Interpolate.Util+import qualified Data.Text as T+import qualified Data.Text.IO as T+import Elm (toElmDecoderSource,+ toElmEncoderSource,+ toElmTypeSource)+import GenerateSpec+import Servant.API (NoContent)+import Servant.Elm+import System.Directory (canonicalizePath,+ createDirectoryIfMissing,+ doesDirectoryExist,+ getCurrentDirectory, removeFile,+ setCurrentDirectory)+import System.Process++spec :: Test.Hspec.Spec+spec = do+ describe "generateElmForAPI" $ do+ it "creates compilable javascript" $ do+ inTempElmDir $ do+ let generated =+ T.intercalate "\n\n" $+ defElmImports :+ [ toElmTypeSource (Proxy :: Proxy NoContent)+ , toElmTypeSource (Proxy :: Proxy Book)+ , toElmDecoderSource (Proxy :: Proxy Book)+ , toElmEncoderSource (Proxy :: Proxy Book)+ ] +++ generateElmForAPI testApi+ T.writeFile "Api.elm" generated+ callCommand "elm-make Api.elm --output api.js"++inTempElmDir :: IO a -> IO a+inTempElmDir action = do+ cacheExists <- doesDirectoryExist "_test-cache"+ when (not cacheExists)+ createCache+ cacheDir <- canonicalizePath "_test-cache"+ inTempDirectory $ do+ callCommand ("cp -r " ++ cacheDir ++ "/* .")+ action++createCache :: IO ()+createCache = do+ createDirectoryIfMissing True "_test-cache"+ withCurrentDirectory "_test-cache" $ do+ writeFile "elm-package.json" $ unindent $ [i|+ {+ "version": "1.0.0",+ "summary": "helpful summary of your project, less than 80 characters",+ "repository": "https://github.com/user/project.git",+ "license": "BSD3",+ "source-directories": [+ "."+ ],+ "exposed-modules": [],+ "dependencies": {+ "elm-lang/core": "4.0.1 <= v < 5.0.0",+ "elm-community/json-extra": "1.0.0 <= v < 2.0.0",+ "evancz/elm-http": "3.0.1 <= v < 4.0.0",+ "NoRedInk/elm-decode-pipeline": "2.0.0 <= v < 3.0.0"+ },+ "elm-version": "0.17.0 <= v < 0.18.0"+ }+ |]+ callCommand "elm-package install --yes"+ compileDependencies++compileDependencies :: IO ()+compileDependencies = do+ writeFile "Main.elm" "foo = 42"+ callCommand "elm-make Main.elm --output main.js"+ removeFile "Main.elm"+ removeFile "main.js"++withCurrentDirectory :: FilePath -> IO a -> IO a+withCurrentDirectory dir action =+ bracket enter recover (const action)+ where+ enter = do+ original <- getCurrentDirectory+ setCurrentDirectory dir+ return original+ recover = setCurrentDirectory
+ test/GenerateSpec.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}++module GenerateSpec where++import Test.Hspec++import Control.Monad (zipWithM_)+import Data.Aeson (ToJSON)+import Data.Monoid ((<>))+import qualified Data.Text.IO as T+import GHC.Generics (Generic)+import Servant.API+import Servant.Elm+++data Book = Book+ { title :: String+ } deriving Generic++instance ToJSON Book+instance ElmType Book+++type TestApi =+ "one" :> Get '[JSON] Int+ :<|> "two" :> ReqBody '[JSON] String+ :> Post '[JSON] (Maybe Int)+ :<|> "books" :> Capture "id" Int+ :> Get '[JSON] Book+ :<|> "books" :> Capture "title" String+ :> Get '[JSON] Book+ :<|> "books" :> QueryFlag "published"+ :> QueryParam "sort" String+ :> QueryParam "year" Int+ :> QueryParams "filters" (Maybe Bool)+ :> Get '[JSON] [Book]+ :<|> "books" :> ReqBody '[JSON] Book+ :> PostNoContent '[JSON] NoContent+ :<|> "nothing" :> GetNoContent '[JSON] NoContent+ :<|> "nothing" :> Put '[JSON] () -- old way to specify no content+ :<|> "with-a-header" :> Header "myStringHeader" String+ :> Header "myIntHeader" Int+ :> Get '[JSON] String++testApi :: Proxy TestApi+testApi = Proxy++spec :: Test.Hspec.Spec+spec = do+ describe "encoding a simple api" $ do+ it "does it" $ do+ expected <- mapM T.readFile+ [ "test/elm-sources/getOneSource.elm"+ , "test/elm-sources/postTwoSource.elm"+ , "test/elm-sources/getBooksByIdSource.elm"+ , "test/elm-sources/getBooksByTitleSource.elm"+ , "test/elm-sources/getBooksSource.elm"+ , "test/elm-sources/emptyResponseHandlerSource.elm"+ , "test/elm-sources/handleResponseSource.elm"+ , "test/elm-sources/promoteErrorSource.elm"+ , "test/elm-sources/postBooksSource.elm"+ , "test/elm-sources/getNothingSource.elm"+ , "test/elm-sources/putNothingSource.elm"+ , "test/elm-sources/getWithaheaderSource.elm"+ ]++ let generated = map (<> "\n") (generateElmForAPI testApi)++ generated `itemsShouldBe` expected++itemsShouldBe :: (Monoid a, Eq a, Show a) => [a] -> [a] -> IO ()+itemsShouldBe actual expected =+ zipWithM_ shouldBe (actual ++ replicate (length expected - length actual) mempty)+ (expected ++ replicate (length actual - length expected) mempty)
test/Spec.hs view
@@ -1,59 +1,1 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE DataKinds #-}--import Test.Hspec--import Control.Monad (zipWithM_)-import Data.Aeson (ToJSON)-import Data.Default (Default, def)-import Data.Proxy (Proxy(Proxy))-import Elm (ToElmType)-import GHC.Generics (Generic)-import Servant.API-import Servant.Elm---data Book = Book- { title :: String- } deriving Generic--instance ToJSON Book-instance ToElmType Book---type TestApi = "one" :> Get '[JSON] Int- :<|> "two" :> ReqBody '[JSON] String :> Post '[JSON] (Maybe Int)- :<|> "books" :> Capture "id" Int :> Get '[JSON] Book- :<|> "books" :> QueryFlag "published"- :> QueryParam "sort" String- :> QueryParams "filters" (Maybe Bool)- :> Get '[JSON] [Book]- :<|> "nothing" :> Get '[JSON] ()--main :: IO ()-main = hspec $- describe "encoding a simple api" $- it "does it" $ do- getOneSource <- readFile "test/getOneSource.elm"- postTwoSource <- readFile "test/postTwoSource.elm"- bookTypeSource <- readFile "test/bookTypeSource.elm"- decodeBookSource <- readFile "test/decodeBookSource.elm"- getBooksBySource <- readFile "test/getBooksBySource.elm"- getBooksSource <- readFile "test/getBooksSource.elm"- getNothingSource <- readFile "test/getNothingSource.elm"- let generated = map (++ "\n") (generateElmForAPI (Proxy :: Proxy TestApi))- expected = [ getOneSource- , postTwoSource- , bookTypeSource- , decodeBookSource- , getBooksBySource- , getBooksSource- , getNothingSource- ]- generated `itemsShouldBe` expected--itemsShouldBe :: (Default a, Eq a, Show a) => [a] -> [a] -> IO ()-itemsShouldBe actual expected =- zipWithM_ shouldBe (actual ++ replicate (length expected - length actual) def)- (expected ++ replicate (length actual - length expected) def)+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}