packages feed

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 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+        }