json-spec-elm-servant 0.4.0.2 → 0.4.1.0
raw patch · 2 files changed
+175/−20 lines, 2 filesdep +filepathPVP ok
version bump matches the API change (PVP)
Dependencies added: filepath
API changes (from Hackage documentation)
+ Data.JsonSpec.Elm.Servant: generateElm :: forall {k} (api :: k). Elmable api => OsPath -> Proxy api -> IO ()
Files
- json-spec-elm-servant.cabal +16/−15
- src/Data/JsonSpec/Elm/Servant.hs +159/−5
json-spec-elm-servant.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: json-spec-elm-servant-version: 0.4.0.2+version: 0.4.1.0 synopsis: Generated elm code for servant APIs. description: Generate Elm encoders, decoders, and API requests for an Servant API, where the shape of the data@@ -23,12 +23,21 @@ common dependencies build-depends:- , base >= 4.19.0.0 && < 4.20- , containers >= 0.6.8 && < 0.7- , elm-syntax >= 0.3.3.0 && < 0.4- , json-spec >= 0.3.0.0 && < 0.6- , servant >= 0.20.1 && < 0.21- , text >= 2.1 && < 2.2+ , base >= 4.19.0.0 && < 4.20+ , bound >= 2.0.7 && < 2.1+ , containers >= 0.6.8 && < 0.7+ , directory >= 1.3.8.1 && < 1.4+ , elm-syntax >= 0.3.3.0 && < 0.4+ , filepath >= 1.4.300.2 && < 1.5+ , http-types >= 0.12.3 && < 0.13+ , json-spec >= 0.3.0.0 && < 0.6+ , json-spec-elm >= 0.4.0.0 && < 0.5+ , mtl >= 2.3.1 && < 2.4+ , prettyprinter >= 1.7.1 && < 1.8+ , process >= 1.6.18.0 && < 1.7+ , servant >= 0.20.1 && < 0.21+ , text >= 2.1 && < 2.2+ , unordered-containers >= 0.2.19.1 && < 0.3 common warnings ghc-options:@@ -48,11 +57,6 @@ default-language: Haskell2010 ghc-options: -Wunused-packages- build-depends:- , bound >= 2.0.7 && < 2.1- , http-types >= 0.12.3 && < 0.13- , json-spec-elm >= 0.4.0.0 && < 0.5- , mtl >= 2.3.1 && < 2.4 flag compile-elm description:@@ -72,10 +76,7 @@ , binary >= 0.8.9.1 && < 0.9 , bytestring >= 0.12.0.2 && < 0.13 , cookie >= 0.4.6 && < 0.5- , directory >= 1.3.8.1 && < 1.4 , hspec >= 2.11.1 && < 2.12- , prettyprinter >= 1.7.1 && < 1.8- , process >= 1.6.18.0 && < 1.7 , time >= 1.12.2 && < 1.13 , unordered-containers >= 0.2.19.1 && < 0.3 , uuid >= 1.3.15 && < 1.4
src/Data/JsonSpec/Elm/Servant.hs view
@@ -7,6 +7,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-}+{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}@@ -17,6 +18,7 @@ module Data.JsonSpec.Elm.Servant ( -- * Generating Elm Clients servantDefs,+ generateElm, -- * Extensions {-|@@ -37,12 +39,14 @@ import Bound (Var(B, F), Scope, abstract1, closed, toScope) import Control.Monad.Writer (MonadTrans(lift), MonadWriter(tell), execWriter)-import Data.Foldable (Foldable(fold))+import Data.Foldable (Foldable(fold), traverse_)+import Data.HashMap.Strict (HashMap) import Data.JsonSpec (HasJsonDecodingSpec(DecodingSpec), HasJsonEncodingSpec(EncodingSpec)) import Data.JsonSpec.Elm (HasType(decoderOf, encoderOf, typeOf), Definitions)-import Data.Maybe (fromMaybe, mapMaybe)+import Data.List (drop, foldl', init, unlines)+import Data.Maybe (fromJust, fromMaybe, mapMaybe) import Data.Proxy (Proxy(Proxy)) import Data.Set (Set) import Data.String (IsString(fromString))@@ -51,30 +55,51 @@ import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) import Language.Elm.Definition (Definition) import Language.Elm.Expression ((<|), Expression)+import Language.Elm.Name (Module)+import Language.Elm.Pretty (modules) import Language.Elm.Type (Type) import Network.HTTP.Types (Method)-import Prelude (Applicative(pure), Foldable(foldr, length), Maybe(Just,- Nothing), Semigroup((<>)), ($), (.), (<$>), Eq, Int, error, reverse)+import Prelude (Applicative(pure), Bool(False, True), Eq((==)),+ Foldable(foldr, length), Functor(fmap), Maybe(Just, Nothing),+ Monad((>>=)), Monoid(mconcat), Semigroup((<>)), Show(show),+ Traversable(sequence, traverse), ($), (.), (<$>), IO, Int, String,+ error, putStrLn, reverse)+import Prettyprinter (defaultLayoutOptions, layoutPretty)+import Prettyprinter.Render.Text (renderStrict) import Servant.API (ReflectMethod(reflectMethod), (:<|>), (:>), Capture, Header', Headers, JSON, NamedRoutes, NoContent, NoContentVerb, Optional, QueryParam', ReqBody', Required, ToServantApi, Verb)+import System.Directory.OsPath (createDirectoryIfMissing,+ doesDirectoryExist, listDirectory)+import System.OsPath ((</>), OsPath, OsString, osp, splitExtension)+import System.Process (readProcess)+import qualified Data.HashMap.Strict as HM import qualified Data.Set as Set import qualified Data.Text as Text import qualified Data.Text.Encoding as TE+import qualified Data.Text.IO as TIO import qualified Language.Elm.Definition as Def import qualified Language.Elm.Expression as Expr import qualified Language.Elm.Name as Name import qualified Language.Elm.Pattern as Pat import qualified Language.Elm.Type as Type+import qualified System.OsPath as OsPath {-| This function will traverse the @api@ type, generating elm definitions for:+ * Http requests for each endpoint, including encoders and decoders for anonymous elm types.+ * Named Elm types (i.e. Any 'Specification' that is bound to a name using 'JsonLet'+ * Decoders and Encoders for named elm types.++ You can consume the resulting 'Definition's using the+ [elm-syntax:Language.Elm.Pretty](https://hackage.haskell.org/package/elm-syntax-0.3.3.0/docs/Language-Elm-Pretty.html)+ module. -} servantDefs :: forall api. (Elmable api) => Proxy api -> Set Definition servantDefs _ =@@ -470,7 +495,7 @@ [ let name :: Text name = case qp of { RequiredQP n -> n; OptionalQP n -> n}- + queryExpr :: Expression Param queryExpr = Expr.apps@@ -554,4 +579,133 @@ => b sym = fromString $ symbolVal (Proxy @a) ++{-|+ "Batteries included" way to generate some Elm code on disk in a given+ a directory. The directory should be dedicated to the generated Elm+ code and you shouldn't try to store anything else in that directory,+ Elm files or otherwise.++ This function will succeed without error if (and only if) the directory+ already exists /and/ its contents exactly match what would be generated+ anyway.++ If the files on disk are wrong, then an error is thrown, and the files+ are unmodified.++ If the directory does not exist, then it is created and the Elm code+ is generated inside the directory, /then an error is thrown/.++ The intent is that you can use this function (thinly wrapped with+ the appropriate directory and api spec) as the main function for a+ test suite, where the "test" is that the files on disk are /already/+ correct. We throw an error even in the case where we generate files+ for you because, for instance, you wouldn't want CI to be generating+ these files when you forgot to check them in in the first place.+-}+generateElm+ :: forall api. (Elmable api)+ => OsPath {-^ The directory in which to deposit Elm code. -}+ -> Proxy api+ -> IO ()+generateElm dir Proxy = do+ definitions :: HashMap Module Text+ <-+ traverse+ (+ elmFormat+ . (<> "\n")+ . renderStrict+ . layoutPretty defaultLayoutOptions+ )+ . modules+ . Set.toList+ $ servantDefs (Proxy @api)++ doesDirectoryExist dir >>= \case+ False -> do+ traverse_ writeModule (HM.toList definitions)+ error $+ unlines+ [ ""+ , " We successfully generated the elm code, but we are going to"+ , " fail the test anyway because the the success criteria for"+ , " the test is that the generated files on disk are _already_"+ , " correct. You wouldn't want CI to pass in this case,"+ , " for instance."+ ]+ True -> do+ checkModules definitions+ putStrLn "Test passes. Generated files are up to date."+ where+ elmFormat :: Text -> IO Text+ elmFormat elmCode = do+ putStrLn $ "Formatting: " <> show elmCode+ result <-+ Text.pack <$>+ readProcess+ "elm-format"+ ["--stdin"]+ (Text.unpack elmCode)+ putStrLn $ "Result: " <> show result+ pure result+++ checkModules :: HashMap Module Text -> IO ()+ checkModules generatedModules = do+ modulesOnDisk <- getFiles dir+ if modulesOnDisk == generatedModules+ then pure ()+ else do+ putStrLn $+ unlines+ [ "expected: " <> show generatedModules+ , "actual: " <> show modulesOnDisk+ , ""+ ]+ error $+ "Please regenerate modules by completely deleting the `"+ <> show dir <> "` directory and then running the test again."+ where+ getFiles :: OsPath -> IO (HashMap Module Text)+ getFiles path =+ case splitExtension path of+ (pToStr -> mod, pToStr -> ".elm") -> do+ content <- TIO.readFile (pToStr path)+ pure $+ HM.singleton+ (+ drop 1+ . Text.split (== '/')+ . Text.pack+ $ mod+ )+ content+ _ -> do+ children <- listDirectory path+ fmap mconcat . sequence $+ [ getFiles (path </> child)+ | child <- children+ ]+++ writeModule :: (Module, Text) -> IO ()+ writeModule (module_, content) = do+ createDirectoryIfMissing True dirname+ path <- OsPath.decodeUtf filename+ TIO.writeFile path content+ where+ pathName :: [Text] -> OsPath+ pathName =+ foldl' (</>) dir+ . fmap (fromJust . OsPath.encodeUtf . Text.unpack)++ filename :: OsPath+ filename = pathName module_ <> [osp|.elm|]++ dirname :: OsPath+ dirname = pathName (init module_)++ pToStr :: OsString -> String+ pToStr = fmap OsPath.toChar . OsPath.unpack