servant-elm 0.2.0.0 → 0.3.0.0
raw patch · 17 files changed
+612/−344 lines, 17 filesdep +Diffdep +HUnitdep +wl-pprint-textdep −formattingPVP ok
version bump matches the API change (PVP)
Dependencies added: Diff, HUnit, wl-pprint-text
Dependencies removed: formatting
API changes (from Hackage documentation)
- Servant.Elm.Internal.Generate: cr :: Text
- Servant.Elm.Internal.Generate: inQuotes :: Text -> Text
- Servant.Elm.Internal.Generate: mkArgsList :: Req ElmDatatype -> [Text]
- Servant.Elm.Internal.Generate: mkHttpRequest :: Text -> ElmOptions -> Req ElmDatatype -> (Text, [Text])
- Servant.Elm.Internal.Generate: mkLetRequest :: Text -> ElmOptions -> Req ElmDatatype -> Text
- Servant.Elm.Internal.Generate: quote :: Text
+ Servant.Elm.Internal.Generate: docToText :: Doc -> Text
+ Servant.Elm.Internal.Generate: elmList :: [Doc] -> Doc
+ Servant.Elm.Internal.Generate: elmRecord :: [Doc] -> Doc
+ Servant.Elm.Internal.Generate: i :: Int
+ Servant.Elm.Internal.Generate: mkArgs :: Req ElmDatatype -> Doc
+ Servant.Elm.Internal.Generate: mkRequest :: ElmOptions -> Req ElmDatatype -> Doc
+ Servant.Elm.Internal.Generate: stext :: Text -> Doc
- Servant.Elm.Internal.Generate: generateElmForRequest :: ElmOptions -> Req ElmDatatype -> [Text]
+ Servant.Elm.Internal.Generate: generateElmForRequest :: ElmOptions -> Req ElmDatatype -> Doc
- Servant.Elm.Internal.Generate: mkLetParams :: Text -> ElmOptions -> Req ElmDatatype -> Maybe Text
+ Servant.Elm.Internal.Generate: mkLetParams :: ElmOptions -> Req ElmDatatype -> Maybe Doc
- Servant.Elm.Internal.Generate: mkQueryParams :: Text -> Req ElmDatatype -> [Text]
+ Servant.Elm.Internal.Generate: mkQueryParams :: Req ElmDatatype -> Doc
- Servant.Elm.Internal.Generate: mkTypeSignature :: ElmOptions -> Req ElmDatatype -> Text
+ Servant.Elm.Internal.Generate: mkTypeSignature :: ElmOptions -> Req ElmDatatype -> Doc
- Servant.Elm.Internal.Generate: mkUrl :: Text -> ElmOptions -> [Segment ElmDatatype] -> Text
+ Servant.Elm.Internal.Generate: mkUrl :: ElmOptions -> [Segment ElmDatatype] -> Doc
Files
- CHANGELOG.md +5/−0
- README.md +24/−20
- examples/readme-example/generate.hs +2/−2
- servant-elm.cabal +7/−4
- src/Servant/Elm/Internal/Generate.hs +182/−262
- test/CompileSpec.hs +5/−5
- test/GenerateSpec.hs +88/−51
- test/elm-sources/elm-package.json +16/−0
- test/elm-sources/getBooksByIdSource.elm +27/−0
- test/elm-sources/getBooksByTitleSource.elm +27/−0
- test/elm-sources/getBooksSource.elm +49/−0
- test/elm-sources/getNothingSource.elm +32/−0
- test/elm-sources/getOneSource.elm +27/−0
- test/elm-sources/getWithaheaderSource.elm +29/−0
- test/elm-sources/postBooksSource.elm +32/−0
- test/elm-sources/postTwoSource.elm +28/−0
- test/elm-sources/putNothingSource.elm +32/−0
CHANGELOG.md view
@@ -1,3 +1,8 @@+0.3.0.0+-------+* Update for Elm 0.18 and the new elm-lang/http library.+* Generated Elm functions now return an `Http.Request` value.+ 0.2.0.0 ------- * Use Text throughout the API.
README.md view
@@ -32,8 +32,8 @@ ```haskell data Book = Book- { name :: String- } deriving (Generic)+ { name :: String+ } deriving (Generic) instance ElmType Book @@ -72,7 +72,6 @@ import Json.Encode import Http import String-import Task type alias Book =@@ -84,24 +83,29 @@ decode Book |> required "name" string -getBooksByBookId : Int -> Task.Task Http.Error (Book)+getBooksByBookId : Int -> Http.Request (Book) getBooksByBookId bookId =- let- request =- { verb =- "GET"- , headers =- [("Content-Type", "application/json")]- , url =- "/" ++ "books"- ++ "/" ++ (bookId |> toString |> Http.uriEncode)- , body =- Http.empty- }- in- Http.fromJson- decodeBook- (Http.send Http.defaultSettings request)+ Http.request+ { method =+ "GET"+ , headers =+ [ Http.header "Content-Type" "application/json"+ ]+ , url =+ String.join "/"+ [ ""+ , "books"+ , bookId |> toString |> Http.encodeUri+ ]+ , body =+ Http.emptyBody+ , expect =+ Http.expectJson decodeBook+ , timeout =+ Nothing+ , withCredentials =+ False+ } ``` See [`examples`](examples) for a complete usage example, or take a look at
examples/readme-example/generate.hs view
@@ -11,8 +11,8 @@ generateElmForAPI) data Book = Book- { name :: String- } deriving (Generic)+ { name :: String+ } deriving ((Generic)) instance ElmType Book
servant-elm.cabal view
@@ -1,5 +1,5 @@ name: servant-elm-version: 0.2.0.0+version: 0.3.0.0 synopsis: Automatically derive Elm functions to query servant webservices. description: Please see README.md homepage: http://github.com/mattjbray/servant-elm#readme@@ -13,6 +13,8 @@ extra-source-files: CHANGELOG.md README.md+ test/elm-sources/elm-package.json+ test/elm-sources/*.elm cabal-version: >=1.10 flag examples@@ -27,11 +29,11 @@ , Servant.Elm.Internal.Orphans build-depends: base >= 4.7 && < 5 , elm-export >= 0.5- , formatting , lens , servant >= 0.8 , servant-foreign >= 0.8 , text+ , wl-pprint-text ghc-options: -Wall default-language: Haskell2010 @@ -41,12 +43,13 @@ main-is: Spec.hs other-modules: CompileSpec , GenerateSpec- build-depends: aeson >= 0.9+ build-depends: Diff+ , HUnit+ , aeson >= 0.9 , base , data-default , directory , elm-export >= 0.5- , formatting , hspec , interpolate , mockery
src/Servant/Elm/Internal/Generate.hs view
@@ -3,21 +3,22 @@ {-# LANGUAGE OverloadedStrings #-} module Servant.Elm.Internal.Generate where -import Control.Lens (to, view, (^.))+import Prelude hiding ((<$>))+import Control.Lens (to, (^.)) 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.Lazy as L 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+import Text.PrettyPrint.Leijen.Text {-|@@ -80,7 +81,6 @@ > import Json.Encode > import Http > import String-> import Task -} defElmImports :: Text defElmImports =@@ -90,7 +90,6 @@ , "import Json.Encode" , "import Http" , "import String"- , "import Task" ] @@ -122,85 +121,77 @@ -> Proxy api -> [Text] generateElmForAPIWith opts =- nub . concatMap (generateElmForRequest opts) . getEndpoints--cr :: Text-cr = "\n"--quote :: Text-quote = "\""+ nub . map docToText . map (generateElmForRequest opts) . getEndpoints -inQuotes :: Text -> Text-inQuotes s = quote <> s <> quote+i :: Int+i = 4 {-| 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 :: ElmOptions -> F.Req ElmDatatype -> Doc generateElmForRequest opts request =- supportingFunctions- ++ [funcDef]+ funcDef where funcDef =- fnName <> " : " <> typeSignature <> cr <>- T.unwords (fnName : args) <> " =" <> cr <>- " let" <> cr <>- (maybe "" (<> cr) letParams) <>- letRequest <> cr <>- " in" <> cr <>- httpRequest+ vsep+ [ fnName <+> ":" <+> typeSignature+ , fnName <+> args <+> equals+ , case letParams of+ Just params ->+ indent i+ (vsep ["let"+ , indent i params+ , "in"+ , indent i elmRequest+ ])+ Nothing ->+ indent i elmRequest+ ] fnName =- request ^. F.reqFuncName . to F.camelCase+ request ^. F.reqFuncName . to F.camelCase . to stext typeSignature = mkTypeSignature opts request args =- mkArgsList request+ mkArgs request letParams =- mkLetParams " " opts request-- letRequest =- mkLetRequest " " opts request+ mkLetParams opts request - (httpRequest, supportingFunctions) =- mkHttpRequest " " opts request+ elmRequest =+ mkRequest opts request -mkTypeSignature- :: ElmOptions- -> F.Req ElmDatatype- -> Text+mkTypeSignature :: ElmOptions -> F.Req ElmDatatype -> Doc mkTypeSignature opts request =- T.intercalate " -> "- ( headerTypes- ++ urlCaptureTypes- ++ queryTypes- ++ catMaybes [bodyType, returnType])+ (hsep . punctuate " ->" . concat)+ [ headerTypes+ , urlCaptureTypes+ , queryTypes+ , catMaybes [bodyType, returnType]+ ] where- elmTypeRef :: ElmDatatype -> Text+ elmTypeRef :: ElmDatatype -> Doc elmTypeRef eType =- Elm.toElmTypeRefWith (elmExportOptions opts) eType+ stext (Elm.toElmTypeRefWith (elmExportOptions opts) eType) - headerTypes :: [Text]+ headerTypes :: [Doc] headerTypes = [ header ^. F.headerArg . F.argType . to elmTypeRef | header <- request ^. F.reqHeaders ] - urlCaptureTypes :: [Text]+ urlCaptureTypes :: [Doc] urlCaptureTypes = [ F.captureArg capture ^. F.argType . to elmTypeRef | capture <- request ^. F.reqUrl . F.path , F.isCapture capture ] - queryTypes :: [Text]+ queryTypes :: [Doc] queryTypes = [ arg ^. F.queryArgName . F.argType . to (elmTypeRef . wrapper) | arg <- request ^. F.reqUrl . F.queryStr@@ -213,99 +204,54 @@ ] ] - bodyType :: Maybe Text+ bodyType :: Maybe Doc bodyType =- elmTypeRef <$> request ^. F.reqBody+ fmap elmTypeRef $ request ^. F.reqBody - returnType :: Maybe Text- returnType =- sformat ("Task.Task Http.Error (" % stext % ")") . elmTypeRef <$> request ^. F.reqReturnType+ returnType :: Maybe Doc+ returnType = do+ result <- fmap elmTypeRef $ request ^. F.reqReturnType+ pure ("Http.Request" <+> parens result) -mkArgsList+mkArgs :: 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)+ -> Doc+mkArgs request =+ (hsep . concat) $+ [ -- Headers+ [ header ^. F.headerArg . F.argName . to (stext . F.unPathSegment)+ | header <- request ^. F.reqHeaders+ ]+ , -- URL Captures+ [ F.captureArg segment ^. F.argName . to (stext . F.unPathSegment)+ | segment <- request ^. F.reqUrl . F.path+ , F.isCapture segment+ ]+ , -- Query params+ [ arg ^. F.queryArgName . F.argName . to (stext . F.unPathSegment)+ | arg <- request ^. F.reqUrl . F.queryStr+ ]+ , -- Request body+ maybe [] (const ["body"]) (request ^. F.reqBody) ]- 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 =+mkLetParams :: ElmOptions -> F.Req ElmDatatype -> Maybe Doc+mkLetParams 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- , " ]"- ]+ Just $ "params =" <$>+ indent i ("List.filter (not << String.isEmpty)" <$>+ indent i (elmList params)) where- params :: [Text]- params = map paramToStr (request ^. F.reqUrl . F.queryStr)+ params :: [Doc]+ params = map paramToDoc (request ^. F.reqUrl . F.queryStr) - paramToStr :: F.QueryArg ElmDatatype -> Text- paramToStr qarg =+ paramToDoc :: F.QueryArg ElmDatatype -> Doc+ paramToDoc qarg =+ -- something wrong with indentation here... case qarg ^. F.queryArgType of F.Normal -> let@@ -316,178 +262,134 @@ else "toString >> " in- T.intercalate newLine- [ name- , " |> Maybe.map (" <> toStringSrc <> "Http.uriEncode >> (++) \"" <> name <> "=\")"- , " |> Maybe.withDefault \"\""- ]+ name <$>+ indent 4 ("|> Maybe.map" <+> parens (toStringSrc <> "Http.encodeUri >> (++)" <+> dquotes (name <> equals)) <$>+ "|> Maybe.withDefault" <+> dquotes empty) F.Flag ->- T.intercalate newLine- ["if " <> name <> " then"- , " \"" <> name <> "=\""- , "else"- , " \"\""- ]+ "if" <+> name <+> "then" <$>+ indent 4 (dquotes (name <> equals)) <$>+ indent 2 "else" <$>+ indent 4 (dquotes empty) F.List ->- T.intercalate newLine- [ name- , " |> List.map (\\val -> \"" <> name <> "[]=\" ++ (val |> toString |> Http.uriEncode))"- , " |> String.join \"&\""- ]+ name <$>+ indent 4 ("|> List.map" <+> parens (backslash <> "val ->" <+> dquotes (name <> "[]=") <+> "++ (val |> toString |> Http.encodeUri)") <$>+ "|> String.join" <+> dquotes "&") where name =- F.unPathSegment . view (F.queryArgName . F.argName) $ qarg- newLine = "\n "+ qarg ^. F.queryArgName . F.argName . to (stext . F.unPathSegment) -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- , " }"- ]- )+mkRequest :: ElmOptions -> F.Req ElmDatatype -> Doc+mkRequest opts request =+ "Http.request" <$>+ indent i+ (elmRecord+ [ "method =" <$>+ indent i (dquotes method)+ , "headers =" <$>+ indent i+ (elmList headers)+ , "url =" <$>+ indent i url+ , "body =" <$>+ indent i body+ , "expect =" <$>+ indent i expect+ , "timeout =" <$>+ indent i "Nothing"+ , "withCredentials =" <$>+ indent i "False"+ ]) where method =- T.decodeUtf8 (request ^. F.reqMethod)+ request ^. F.reqMethod . to (stext . T.decodeUtf8) headers =- T.concat . map ((cr <> indent <> " ,") <>) $- ["(" <> inQuotes headerName <> ", " <>- (if isElmStringType opts (header ^. F.headerArg . F.argType) then- ""- else- "toString "- ) <>- headerName <> ")"+ [("Http.header" <+> dquotes headerName <+>+ (if isElmStringType opts (header ^. F.headerArg . F.argType) then+ headerName+ else+ parens ("toString " <> headerName)+ )) | header <- request ^. F.reqHeaders- , headerName <- [header ^. F.headerArg . F.argName . to F.unPathSegment]+ , headerName <- [header ^. F.headerArg . F.argName . to (stext . F.unPathSegment)] ] url =- mkUrl (indent <> " ") opts (request ^. F.reqUrl . F.path)+ mkUrl opts (request ^. F.reqUrl . F.path)+ <> mkQueryParams request body = case request ^. F.reqBody of Nothing ->- "Http.empty"+ "Http.emptyBody" 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"- ]-+ "Http.jsonBody" <+> parens (stext encoderName <+> "body") -{-| 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) =+ expect = case request ^. F.reqReturnType of Just elmTypeExpr | isEmptyType opts elmTypeExpr ->- (emptyResponseRequest (Elm.toElmTypeRefWith (elmExportOptions opts) elmTypeExpr)- , [ emptyResponseHandlerSrc- , handleResponseSrc- , promoteErrorSrc- ]- )+ let elmConstructor =+ Elm.toElmTypeRefWith (elmExportOptions opts) elmTypeExpr+ in+ "Http.expectStringResponse" <$>+ indent i (parens (backslash <> braces " body " <+> "->" <$>+ indent i ("if String.isEmpty body then" <$>+ indent i "Ok" <+> stext elmConstructor <$>+ "else" <$>+ indent i ("Err" <+> dquotes "Expected the response body to be empty")) <> line)) + Just elmTypeExpr ->- ( jsonRequest (Elm.toElmDecoderRefWith (elmExportOptions opts) elmTypeExpr)- , []- )+ "Http.expectJson" <+> stext (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 <> ")"- ]+mkUrl :: ElmOptions -> [F.Segment ElmDatatype] -> Doc+mkUrl opts segments =+ "String.join" <+> dquotes "/" <$>+ (indent i . elmList)+ ( dquotes (stext (urlPrefix opts))+ : map segmentToDoc segments)+ where - 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)"- ]+ segmentToDoc :: F.Segment ElmDatatype -> Doc+ segmentToDoc s =+ case F.unSegment s of+ F.Static path ->+ dquotes (stext (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+ empty+ else+ " |> toString"+ in+ (arg ^. F.argName . to (stext . F.unPathSegment )) <> toStringSrc <> " |> Http.encodeUri" - 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"- ]+mkQueryParams+ :: F.Req ElmDatatype+ -> Doc+mkQueryParams request =+ if null (request ^. F.reqUrl . F.queryStr) then+ empty+ else+ line <> "++" <+> align ("if List.isEmpty params then" <$>+ indent i (dquotes empty) <$>+ "else" <$>+ indent i (dquotes "?" <+> "++ String.join" <+> dquotes "&" <+> "params")) {- | Determines whether we construct an Elm function that expects an empty@@ -504,3 +406,21 @@ isElmStringType :: ElmOptions -> ElmDatatype -> Bool isElmStringType opts elmTypeExpr = elmTypeExpr `elem` stringElmTypes opts+++-- Doc helpers+++docToText :: Doc -> Text+docToText =+ L.toStrict . displayT . renderPretty 0.4 100++stext :: Text -> Doc+stext = text . L.fromStrict++elmRecord :: [Doc] -> Doc+elmRecord = encloseSep (lbrace <> space) (line <> rbrace) (comma <> space)++elmList :: [Doc] -> Doc+elmList [] = lbracket <> rbracket+elmList ds = lbracket <+> hsep (punctuate (line <> comma) ds) <$> rbracket
test/CompileSpec.hs view
@@ -67,12 +67,12 @@ ], "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-lang/core": "5.0.0 <= v < 6.0.0",+ "elm-community/json-extra": "2.0.0 <= v < 3.0.0",+ "elm-lang/http": "1.0.0 <= v < 2.0.0",+ "NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0" },- "elm-version": "0.17.0 <= v < 0.18.0"+ "elm-version": "0.18.0 <= v < 0.19.0" } |] callCommand "elm-package install --yes"
test/GenerateSpec.hs view
@@ -5,73 +5,110 @@ 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 Control.Monad (zipWithM_)+import Data.Aeson (ToJSON)+import qualified Data.Algorithm.Diff as Diff+import qualified Data.Algorithm.DiffOutput as Diff+import Data.Monoid ((<>))+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import GHC.Generics (Generic) import Servant.API import Servant.Elm+import Test.Hspec (Spec, describe, it)+import Test.HUnit (Assertion, assertBool) data Book = Book- { title :: String- } deriving Generic+ { 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+ "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+ describe "encoding a simple api" $+ do it "does it" $+ do expected <-+ mapM+ (\(fpath,header) -> do+ source <- T.readFile fpath+ return (fpath, header, source))+ [ ( "test/elm-sources/getOneSource.elm"+ , "module GetOneSource exposing (..)\n\n" <>+ "import Http\n" <>+ "import Json.Decode exposing (..)\n\n\n")+ , ( "test/elm-sources/postTwoSource.elm"+ , "module PostTwoSource exposing (..)\n\n" <>+ "import Http\n" <>+ "import Json.Decode exposing (..)\n" <>+ "import Json.Encode\n\n\n")+ , ( "test/elm-sources/getBooksByIdSource.elm"+ , "module GetBooksByIdSource exposing (..)\n\n" <>+ "import Http\n\n\n")+ , ( "test/elm-sources/getBooksByTitleSource.elm"+ , "module GetBooksByTitleSource exposing (..)\n\n" <>+ "import Http\n\n\n")+ , ( "test/elm-sources/getBooksSource.elm"+ , "module GetBooksSource exposing (..)\n\n" <>+ "import Http\n" <>+ "import Json.Decode exposing (..)\n\n\n")+ , ( "test/elm-sources/postBooksSource.elm"+ , "module PostBooksSource exposing (..)\n\n" <>+ "import Http\n\n\n")+ , ( "test/elm-sources/getNothingSource.elm"+ , "module GetNothingSource exposing (..)\n\n" <>+ "import Http\n\n\n")+ , ( "test/elm-sources/putNothingSource.elm"+ , "module PutNothingSource exposing (..)\n\n" <>+ "import Http\n\n\n")+ , ( "test/elm-sources/getWithaheaderSource.elm"+ , "module GetWithAHeaderSource exposing (..)\n\n" <>+ "import Http\n" <>+ "import Json.Decode exposing (..)\n\n\n")]+ let generated = map (<> "\n") (generateElmForAPI testApi)+ generated `itemsShouldBe` expected -itemsShouldBe :: (Monoid a, Eq a, Show a) => [a] -> [a] -> IO ()+itemsShouldBe :: [Text] -> [(String, Text, Text)] -> IO () itemsShouldBe actual expected =- zipWithM_ shouldBe (actual ++ replicate (length expected - length actual) mempty)- (expected ++ replicate (length actual - length expected) mempty)+ zipWithM_+ shouldBeDiff+ (actual ++ replicate (length expected - length actual) mempty)+ (expected ++ replicate (length actual - length expected) mempty)++shouldBeDiff :: Text -> (String, Text, Text) -> Assertion+shouldBeDiff a (fpath,header,b) =+ assertBool+ ("< generated\n" <> "> " <> fpath <> "\n" <>+ Diff.ppDiff+ (Diff.getGroupedDiff+ (lines (T.unpack (header <> a)))+ (lines (T.unpack b))))+ (header <> a == b)
+ test/elm-sources/elm-package.json view
@@ -0,0 +1,16 @@+{+ "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": "5.0.0 <= v < 6.0.0",+ "elm-lang/html": "2.0.0 <= v < 3.0.0",+ "elm-lang/http": "1.0.0 <= v < 2.0.0"+ },+ "elm-version": "0.18.0 <= v < 0.19.0"+}
+ test/elm-sources/getBooksByIdSource.elm view
@@ -0,0 +1,27 @@+module GetBooksByIdSource exposing (..)++import Http+++getBooksById : Int -> Http.Request (Book)+getBooksById id =+ Http.request+ { method =+ "GET"+ , headers =+ []+ , url =+ String.join "/"+ [ ""+ , "books"+ , id |> toString |> Http.encodeUri+ ]+ , body =+ Http.emptyBody+ , expect =+ Http.expectJson decodeBook+ , timeout =+ Nothing+ , withCredentials =+ False+ }
+ test/elm-sources/getBooksByTitleSource.elm view
@@ -0,0 +1,27 @@+module GetBooksByTitleSource exposing (..)++import Http+++getBooksByTitle : String -> Http.Request (Book)+getBooksByTitle title =+ Http.request+ { method =+ "GET"+ , headers =+ []+ , url =+ String.join "/"+ [ ""+ , "books"+ , title |> Http.encodeUri+ ]+ , body =+ Http.emptyBody+ , expect =+ Http.expectJson decodeBook+ , timeout =+ Nothing+ , withCredentials =+ False+ }
+ test/elm-sources/getBooksSource.elm view
@@ -0,0 +1,49 @@+module GetBooksSource exposing (..)++import Http+import Json.Decode exposing (..)+++getBooks : Bool -> Maybe (String) -> Maybe (Int) -> List (Maybe (Bool)) -> Http.Request (List (Book))+getBooks published sort year filters =+ let+ params =+ List.filter (not << String.isEmpty)+ [ if published then+ "published="+ else+ ""+ , sort+ |> Maybe.map (Http.encodeUri >> (++) "sort=")+ |> Maybe.withDefault ""+ , year+ |> Maybe.map (toString >> Http.encodeUri >> (++) "year=")+ |> Maybe.withDefault ""+ , filters+ |> List.map (\val -> "filters[]=" ++ (val |> toString |> Http.encodeUri))+ |> String.join "&"+ ]+ in+ Http.request+ { method =+ "GET"+ , headers =+ []+ , url =+ String.join "/"+ [ ""+ , "books"+ ]+ ++ if List.isEmpty params then+ ""+ else+ "?" ++ String.join "&" params+ , body =+ Http.emptyBody+ , expect =+ Http.expectJson (list decodeBook)+ , timeout =+ Nothing+ , withCredentials =+ False+ }
+ test/elm-sources/getNothingSource.elm view
@@ -0,0 +1,32 @@+module GetNothingSource exposing (..)++import Http+++getNothing : Http.Request (NoContent)+getNothing =+ Http.request+ { method =+ "GET"+ , headers =+ []+ , url =+ String.join "/"+ [ ""+ , "nothing"+ ]+ , body =+ Http.emptyBody+ , expect =+ Http.expectStringResponse+ (\{ body } ->+ if String.isEmpty body then+ Ok NoContent+ else+ Err "Expected the response body to be empty"+ )+ , timeout =+ Nothing+ , withCredentials =+ False+ }
+ test/elm-sources/getOneSource.elm view
@@ -0,0 +1,27 @@+module GetOneSource exposing (..)++import Http+import Json.Decode exposing (..)+++getOne : Http.Request (Int)+getOne =+ Http.request+ { method =+ "GET"+ , headers =+ []+ , url =+ String.join "/"+ [ ""+ , "one"+ ]+ , body =+ Http.emptyBody+ , expect =+ Http.expectJson int+ , timeout =+ Nothing+ , withCredentials =+ False+ }
+ test/elm-sources/getWithaheaderSource.elm view
@@ -0,0 +1,29 @@+module GetWithAHeaderSource exposing (..)++import Http+import Json.Decode exposing (..)+++getWithaheader : String -> Int -> Http.Request (String)+getWithaheader myStringHeader myIntHeader =+ Http.request+ { method =+ "GET"+ , headers =+ [ Http.header "myStringHeader" myStringHeader+ , Http.header "myIntHeader" (toString myIntHeader)+ ]+ , url =+ String.join "/"+ [ ""+ , "with-a-header"+ ]+ , body =+ Http.emptyBody+ , expect =+ Http.expectJson string+ , timeout =+ Nothing+ , withCredentials =+ False+ }
+ test/elm-sources/postBooksSource.elm view
@@ -0,0 +1,32 @@+module PostBooksSource exposing (..)++import Http+++postBooks : Book -> Http.Request (NoContent)+postBooks body =+ Http.request+ { method =+ "POST"+ , headers =+ []+ , url =+ String.join "/"+ [ ""+ , "books"+ ]+ , body =+ Http.jsonBody (encodeBook body)+ , expect =+ Http.expectStringResponse+ (\{ body } ->+ if String.isEmpty body then+ Ok NoContent+ else+ Err "Expected the response body to be empty"+ )+ , timeout =+ Nothing+ , withCredentials =+ False+ }
+ test/elm-sources/postTwoSource.elm view
@@ -0,0 +1,28 @@+module PostTwoSource exposing (..)++import Http+import Json.Decode exposing (..)+import Json.Encode+++postTwo : String -> Http.Request (Maybe (Int))+postTwo body =+ Http.request+ { method =+ "POST"+ , headers =+ []+ , url =+ String.join "/"+ [ ""+ , "two"+ ]+ , body =+ Http.jsonBody (Json.Encode.string body)+ , expect =+ Http.expectJson (maybe int)+ , timeout =+ Nothing+ , withCredentials =+ False+ }
+ test/elm-sources/putNothingSource.elm view
@@ -0,0 +1,32 @@+module PutNothingSource exposing (..)++import Http+++putNothing : Http.Request (())+putNothing =+ Http.request+ { method =+ "PUT"+ , headers =+ []+ , url =+ String.join "/"+ [ ""+ , "nothing"+ ]+ , body =+ Http.emptyBody+ , expect =+ Http.expectStringResponse+ (\{ body } ->+ if String.isEmpty body then+ Ok ()+ else+ Err "Expected the response body to be empty"+ )+ , timeout =+ Nothing+ , withCredentials =+ False+ }