diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 +``` diff --git a/examples/books/generate.hs b/examples/books/generate.hs new file mode 100644 --- /dev/null +++ b/examples/books/generate.hs @@ -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" diff --git a/examples/e2e-tests/generate.hs b/examples/e2e-tests/generate.hs new file mode 100644 --- /dev/null +++ b/examples/e2e-tests/generate.hs @@ -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" diff --git a/examples/giphy/generate.hs b/examples/giphy/generate.hs new file mode 100644 --- /dev/null +++ b/examples/giphy/generate.hs @@ -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" diff --git a/examples/readme-example/generate.hs b/examples/readme-example/generate.hs new file mode 100644 --- /dev/null +++ b/examples/readme-example/generate.hs @@ -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" diff --git a/servant-elm.cabal b/servant-elm.cabal --- a/servant-elm.cabal +++ b/servant-elm.cabal @@ -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 diff --git a/src/Servant/Elm.hs b/src/Servant/Elm.hs --- a/src/Servant/Elm.hs +++ b/src/Servant/Elm.hs @@ -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) diff --git a/src/Servant/Elm/Client.hs b/src/Servant/Elm/Client.hs deleted file mode 100644 --- a/src/Servant/Elm/Client.hs +++ /dev/null @@ -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 ())" diff --git a/src/Servant/Elm/Generate.hs b/src/Servant/Elm/Generate.hs deleted file mode 100644 --- a/src/Servant/Elm/Generate.hs +++ /dev/null @@ -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 " diff --git a/src/Servant/Elm/Internal/Foreign.hs b/src/Servant/Elm/Internal/Foreign.hs new file mode 100644 --- /dev/null +++ b/src/Servant/Elm/Internal/Foreign.hs @@ -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) diff --git a/src/Servant/Elm/Internal/Generate.hs b/src/Servant/Elm/Internal/Generate.hs new file mode 100644 --- /dev/null +++ b/src/Servant/Elm/Internal/Generate.hs @@ -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 diff --git a/src/Servant/Elm/Internal/Orphans.hs b/src/Servant/Elm/Internal/Orphans.hs new file mode 100644 --- /dev/null +++ b/src/Servant/Elm/Internal/Orphans.hs @@ -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 diff --git a/src/Servant/Elm/Request.hs b/src/Servant/Elm/Request.hs deleted file mode 100644 --- a/src/Servant/Elm/Request.hs +++ /dev/null @@ -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 } diff --git a/test/CompileSpec.hs b/test/CompileSpec.hs new file mode 100644 --- /dev/null +++ b/test/CompileSpec.hs @@ -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 diff --git a/test/GenerateSpec.hs b/test/GenerateSpec.hs new file mode 100644 --- /dev/null +++ b/test/GenerateSpec.hs @@ -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) diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -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 #-}