elm-street (empty) → 0.0.0

raw patch · 15 files changed

+2653/−0 lines, 15 filesdep +aesondep +basedep +directory

Dependencies added: aeson, base, directory, elm-street, filepath, prettyprinter, servant, servant-server, text, time, wai, warp

Files

• CHANGELOG.md +12/−0
• LICENSE +373/−0
• README.md +338/−0
• backend/Api.hs +35/−0
• backend/Main.hs +9/−0
• elm-street.cabal +199/−0
• generate-elm/Main.hs +15/−0
• src/Elm.hs +16/−0
• src/Elm/Aeson.hs +165/−0
• src/Elm/Ast.hs +100/−0
• src/Elm/Generate.hs +168/−0
• src/Elm/Generic.hs +378/−0
• src/Elm/Print.hs +675/−0
• test/Spec.hs +4/−0
• types/Types.hs +166/−0

@@ -0,0 +1,12 @@+# Changelog++`elm-street` uses [PVP Versioning][1].+The changelog is available [on GitHub][2].++0.0.0+=====++* Initially created.++[1]: https://pvp.haskell.org+[2]: https://github.com/Holmusk/elm-street/releases

@@ -0,0 +1,373 @@+Mozilla Public License Version 2.0+==================================++1. Definitions+--------------++1.1. "Contributor"+    means each individual or legal entity that creates, contributes to+    the creation of, or owns Covered Software.++1.2. "Contributor Version"+    means the combination of the Contributions of others (if any) used+    by a Contributor and that particular Contributor's Contribution.++1.3. "Contribution"+    means Covered Software of a particular Contributor.++1.4. "Covered Software"+    means Source Code Form to which the initial Contributor has attached+    the notice in Exhibit A, the Executable Form of such Source Code+    Form, and Modifications of such Source Code Form, in each case+    including portions thereof.++1.5. "Incompatible With Secondary Licenses"+    means++    (a) that the initial Contributor has attached the notice described+        in Exhibit B to the Covered Software; or++    (b) that the Covered Software was made available under the terms of+        version 1.1 or earlier of the License, but not also under the+        terms of a Secondary License.++1.6. "Executable Form"+    means any form of the work other than Source Code Form.++1.7. "Larger Work"+    means a work that combines Covered Software with other material, in+    a separate file or files, that is not Covered Software.++1.8. "License"+    means this document.++1.9. "Licensable"+    means having the right to grant, to the maximum extent possible,+    whether at the time of the initial grant or subsequently, any and+    all of the rights conveyed by this License.++1.10. "Modifications"+    means any of the following:++    (a) any file in Source Code Form that results from an addition to,+        deletion from, or modification of the contents of Covered+        Software; or++    (b) any new file in Source Code Form that contains any Covered+        Software.++1.11. "Patent Claims" of a Contributor+    means any patent claim(s), including without limitation, method,+    process, and apparatus claims, in any patent Licensable by such+    Contributor that would be infringed, but for the grant of the+    License, by the making, using, selling, offering for sale, having+    made, import, or transfer of either its Contributions or its+    Contributor Version.++1.12. "Secondary License"+    means either the GNU General Public License, Version 2.0, the GNU+    Lesser General Public License, Version 2.1, the GNU Affero General+    Public License, Version 3.0, or any later versions of those+    licenses.++1.13. "Source Code Form"+    means the form of the work preferred for making modifications.++1.14. "You" (or "Your")+    means an individual or a legal entity exercising rights under this+    License. For legal entities, "You" includes any entity that+    controls, is controlled by, or is under common control with You. For+    purposes of this definition, "control" means (a) the power, direct+    or indirect, to cause the direction or management of such entity,+    whether by contract or otherwise, or (b) ownership of more than+    fifty percent (50%) of the outstanding shares or beneficial+    ownership of such entity.++2. License Grants and Conditions+--------------------------------++2.1. Grants++Each Contributor hereby grants You a world-wide, royalty-free,+non-exclusive license:++(a) under intellectual property rights (other than patent or trademark)+    Licensable by such Contributor to use, reproduce, make available,+    modify, display, perform, distribute, and otherwise exploit its+    Contributions, either on an unmodified basis, with Modifications, or+    as part of a Larger Work; and++(b) under Patent Claims of such Contributor to make, use, sell, offer+    for sale, have made, import, and otherwise transfer either its+    Contributions or its Contributor Version.++2.2. Effective Date++The licenses granted in Section 2.1 with respect to any Contribution+become effective for each Contribution on the date the Contributor first+distributes such Contribution.++2.3. Limitations on Grant Scope++The licenses granted in this Section 2 are the only rights granted under+this License. No additional rights or licenses will be implied from the+distribution or licensing of Covered Software under this License.+Notwithstanding Section 2.1(b) above, no patent license is granted by a+Contributor:++(a) for any code that a Contributor has removed from Covered Software;+    or++(b) for infringements caused by: (i) Your and any other third party's+    modifications of Covered Software, or (ii) the combination of its+    Contributions with other software (except as part of its Contributor+    Version); or++(c) under Patent Claims infringed by Covered Software in the absence of+    its Contributions.++This License does not grant any rights in the trademarks, service marks,+or logos of any Contributor (except as may be necessary to comply with+the notice requirements in Section 3.4).++2.4. Subsequent Licenses++No Contributor makes additional grants as a result of Your choice to+distribute the Covered Software under a subsequent version of this+License (see Section 10.2) or under the terms of a Secondary License (if+permitted under the terms of Section 3.3).++2.5. Representation++Each Contributor represents that the Contributor believes its+Contributions are its original creation(s) or it has sufficient rights+to grant the rights to its Contributions conveyed by this License.++2.6. Fair Use++This License is not intended to limit any rights You have under+applicable copyright doctrines of fair use, fair dealing, or other+equivalents.++2.7. Conditions++Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted+in Section 2.1.++3. Responsibilities+-------------------++3.1. Distribution of Source Form++All distribution of Covered Software in Source Code Form, including any+Modifications that You create or to which You contribute, must be under+the terms of this License. You must inform recipients that the Source+Code Form of the Covered Software is governed by the terms of this+License, and how they can obtain a copy of this License. You may not+attempt to alter or restrict the recipients' rights in the Source Code+Form.++3.2. Distribution of Executable Form++If You distribute Covered Software in Executable Form then:++(a) such Covered Software must also be made available in Source Code+    Form, as described in Section 3.1, and You must inform recipients of+    the Executable Form how they can obtain a copy of such Source Code+    Form by reasonable means in a timely manner, at a charge no more+    than the cost of distribution to the recipient; and++(b) You may distribute such Executable Form under the terms of this+    License, or sublicense it under different terms, provided that the+    license for the Executable Form does not attempt to limit or alter+    the recipients' rights in the Source Code Form under this License.++3.3. Distribution of a Larger Work++You may create and distribute a Larger Work under terms of Your choice,+provided that You also comply with the requirements of this License for+the Covered Software. If the Larger Work is a combination of Covered+Software with a work governed by one or more Secondary Licenses, and the+Covered Software is not Incompatible With Secondary Licenses, this+License permits You to additionally distribute such Covered Software+under the terms of such Secondary License(s), so that the recipient of+the Larger Work may, at their option, further distribute the Covered+Software under the terms of either this License or such Secondary+License(s).++3.4. Notices++You may not remove or alter the substance of any license notices+(including copyright notices, patent notices, disclaimers of warranty,+or limitations of liability) contained within the Source Code Form of+the Covered Software, except that You may alter any license notices to+the extent required to remedy known factual inaccuracies.++3.5. Application of Additional Terms++You may choose to offer, and to charge a fee for, warranty, support,+indemnity or liability obligations to one or more recipients of Covered+Software. However, You may do so only on Your own behalf, and not on+behalf of any Contributor. You must make it absolutely clear that any+such warranty, support, indemnity, or liability obligation is offered by+You alone, and You hereby agree to indemnify every Contributor for any+liability incurred by such Contributor as a result of warranty, support,+indemnity or liability terms You offer. You may include additional+disclaimers of warranty and limitations of liability specific to any+jurisdiction.++4. Inability to Comply Due to Statute or Regulation+---------------------------------------------------++If it is impossible for You to comply with any of the terms of this+License with respect to some or all of the Covered Software due to+statute, judicial order, or regulation then You must: (a) comply with+the terms of this License to the maximum extent possible; and (b)+describe the limitations and the code they affect. Such description must+be placed in a text file included with all distributions of the Covered+Software under this License. Except to the extent prohibited by statute+or regulation, such description must be sufficiently detailed for a+recipient of ordinary skill to be able to understand it.++5. Termination+--------------++5.1. The rights granted under this License will terminate automatically+if You fail to comply with any of its terms. However, if You become+compliant, then the rights granted under this License from a particular+Contributor are reinstated (a) provisionally, unless and until such+Contributor explicitly and finally terminates Your grants, and (b) on an+ongoing basis, if such Contributor fails to notify You of the+non-compliance by some reasonable means prior to 60 days after You have+come back into compliance. Moreover, Your grants from a particular+Contributor are reinstated on an ongoing basis if such Contributor+notifies You of the non-compliance by some reasonable means, this is the+first time You have received notice of non-compliance with this License+from such Contributor, and You become compliant prior to 30 days after+Your receipt of the notice.++5.2. If You initiate litigation against any entity by asserting a patent+infringement claim (excluding declaratory judgment actions,+counter-claims, and cross-claims) alleging that a Contributor Version+directly or indirectly infringes any patent, then the rights granted to+You by any and all Contributors for the Covered Software under Section+2.1 of this License shall terminate.++5.3. In the event of termination under Sections 5.1 or 5.2 above, all+end user license agreements (excluding distributors and resellers) which+have been validly granted by You or Your distributors under this License+prior to termination shall survive termination.++************************************************************************+*                                                                      *+*  6. Disclaimer of Warranty                                           *+*  -------------------------                                           *+*                                                                      *+*  Covered Software is provided under this License on an "as is"       *+*  basis, without warranty of any kind, either expressed, implied, or  *+*  statutory, including, without limitation, warranties that the       *+*  Covered Software is free of defects, merchantable, fit for a        *+*  particular purpose or non-infringing. The entire risk as to the     *+*  quality and performance of the Covered Software is with You.        *+*  Should any Covered Software prove defective in any respect, You     *+*  (not any Contributor) assume the cost of any necessary servicing,   *+*  repair, or correction. This disclaimer of warranty constitutes an   *+*  essential part of this License. No use of any Covered Software is   *+*  authorized under this License except under this disclaimer.         *+*                                                                      *+************************************************************************++************************************************************************+*                                                                      *+*  7. Limitation of Liability                                          *+*  --------------------------                                          *+*                                                                      *+*  Under no circumstances and under no legal theory, whether tort      *+*  (including negligence), contract, or otherwise, shall any           *+*  Contributor, or anyone who distributes Covered Software as          *+*  permitted above, be liable to You for any direct, indirect,         *+*  special, incidental, or consequential damages of any character      *+*  including, without limitation, damages for lost profits, loss of    *+*  goodwill, work stoppage, computer failure or malfunction, or any    *+*  and all other commercial damages or losses, even if such party      *+*  shall have been informed of the possibility of such damages. This   *+*  limitation of liability shall not apply to liability for death or   *+*  personal injury resulting from such party's negligence to the       *+*  extent applicable law prohibits such limitation. Some               *+*  jurisdictions do not allow the exclusion or limitation of           *+*  incidental or consequential damages, so this exclusion and          *+*  limitation may not apply to You.                                    *+*                                                                      *+************************************************************************++8. Litigation+-------------++Any litigation relating to this License may be brought only in the+courts of a jurisdiction where the defendant maintains its principal+place of business and such litigation shall be governed by laws of that+jurisdiction, without reference to its conflict-of-law provisions.+Nothing in this Section shall prevent a party's ability to bring+cross-claims or counter-claims.++9. Miscellaneous+----------------++This License represents the complete agreement concerning the subject+matter hereof. If any provision of this License is held to be+unenforceable, such provision shall be reformed only to the extent+necessary to make it enforceable. Any law or regulation which provides+that the language of a contract shall be construed against the drafter+shall not be used to construe this License against a Contributor.++10. Versions of the License+---------------------------++10.1. New Versions++Mozilla Foundation is the license steward. Except as provided in Section+10.3, no one other than the license steward has the right to modify or+publish new versions of this License. Each version will be given a+distinguishing version number.++10.2. Effect of New Versions++You may distribute the Covered Software under the terms of the version+of the License under which You originally received the Covered Software,+or under the terms of any subsequent version published by the license+steward.++10.3. Modified Versions++If you create software not governed by this License, and you want to+create a new license for such software, you may create and use a+modified version of this License if you rename the license and remove+any references to the name of the license steward (except to note that+such modified license differs from this License).++10.4. Distributing Source Code Form that is Incompatible With Secondary+Licenses++If You choose to distribute Source Code Form that is Incompatible With+Secondary Licenses under the terms of this version of the License, the+notice described in Exhibit B of this License must be attached.++Exhibit A - Source Code Form License Notice+-------------------------------------------++  This Source Code Form is subject to the terms of the Mozilla Public+  License, v. 2.0. If a copy of the MPL was not distributed with this+  file, You can obtain one at http://mozilla.org/MPL/2.0/.++If it is not possible or desirable to put the notice in a particular+file, then You may include the notice in a location (such as a LICENSE+file in a relevant directory) where a recipient would be likely to look+for such a notice.++You may add additional accurate notices of copyright ownership.++Exhibit B - "Incompatible With Secondary Licenses" Notice+---------------------------------------------------------++  This Source Code Form is "Incompatible With Secondary Licenses", as+  defined by the Mozilla Public License, v. 2.0.

@@ -0,0 +1,338 @@+# elm-street++[![Hackage](https://img.shields.io/hackage/v/elm-street.svg)](https://hackage.haskell.org/package/elm-street)+[![MPL-2.0 license](https://img.shields.io/badge/license-MPL--2.0-blue.svg)](LICENSE)+[![Stackage Lts](http://stackage.org/package/elm-street/badge/lts)](http://stackage.org/lts/package/elm-street)+[![Stackage Nightly](http://stackage.org/package/elm-street/badge/nightly)](http://stackage.org/nightly/package/elm-street)++Crossing the road between Haskell and Elm.++## What this library about?++`Elm-street` allows you to generate automatically derived from Haskell types+definitions of Elm data types, JSON encoders and decoders. This helps to avoid+writing and maintaining huge chunk of boilerplate code when developing full-stack+applications.++## Getting started++In order to use `elm-street` features, you need to perform the following steps:++1. Add `elm-street` to the dependencies of your Haskell package.+2. Derive the `Elm` typeclass for relevant data types. You also need to derive+   JSON instances according to `elm-street` naming scheme.+   This can be done like this:+   ```haskell+   import Elm (Elm, elmStreetParseJson, elmStreetToJson)++   data User = User+       { userName :: Text+       , userAge  :: Int+       } deriving (Generic)+         deriving anyclass (Elm)++   instance ToJSON   User where toJSON = elmStreetToJson+   instance FromJSON User where parseJSON = elmStreetParseJson+   ```+   > **NOTE:** This requires extensions `-XDerivingStrategies`, `-XDeriveGeneric`, `-XDeriveAnyClass`.++   Alternatively you can use `-XDerivingVia` to remove some boilerplate (available since GHC 8.6.1):+   ```haskell+   import Elm (Elm, ElmStreet (..))++   data User = User+       { userName :: Text+       , userAge  :: Int+       } deriving (Generic)+         deriving (Elm, ToJSON, FromJSON) via ElmStreet User+   ```+3. Create list of all types you want to expose to Elm:+   ```haskell+   type Types =+      '[ User+       , Status+       ]+   ```+   > **NOTE:** This requires extension `-XDataKinds`.+4. Use `generateElm` function to output definitions to specified directory under+   specified module prefix.+   ```+   main :: IO ()+   main = generateElm @Types $ defaultSettings "frontend/src" ["Core", "Generated"]+   ```+   > **NOTE:** This requires extension `-XTypeApplications`.++   The above command when called generates the following files:++     + `frontend/src/Core/Generated/Types.elm`: `Core.Generated.Types` module with the definitions of all types+     + `frontend/src/Core/Generated/Encoder.elm`: `Core.Generated.Encoder` module with the JSON encoders for the types+     + `frontend/src/Core/Generated/Decoder.elm`: `Core.Generated.Decoder` module with the JSON decoders for the types+     + `frontend/src/Core/Generated/ElmStreet.elm`: `Core.Generated.ElmStreet` module with bundled helper functions++## Elm-side preparations++If you want to use capabilities provided by `elm-street` in your Elm+application, you need to have several Elm packages preinstalled in the project. You+can install them with the following commands:++```shell+elm install elm/time+elm install elm/json+elm install NoRedInk/elm-json-decode-pipeline+elm install rtfeldman/elm-iso8601-date-strings+```++## Library restrictions++`Elm-street` is **not** trying to be as general as possible and support every+use-case. The library is opinionated in some decisions and contains several+limitations, specifically:++1. Record fields must be prefixed with the type name or its abbreviation.+   ```haskell+   data UserStatus = UserStatus+       { userStatusId      :: Id+       , userStatusRemarks :: Text+       }++   data HealthReading = HealthReading+       { hrUser   :: User+       , hrDate   :: UTCTime+       , hrWeight :: Double+       }+   ```+2. Data types with type variables are not supported (see [issue #45](https://github.com/Holmusk/elm-street/issues/45) for more details).+   Though, if type variables are phantom, you still can implement `Elm` instance which+   will generate valid Elm defintions. Here is how you can create `Elm` instance for+   `newtype`s with phantom type variables:+   ```haskell+   newtype Id a = Id { unId :: Text }++   instance Elm (Id a) where+       toElmDefinition _ = elmNewtype @Text "Id" "unId"+   ```+3. Sum types with records are not supported (because it's a bad practice to have+   records in sum types).+   ```haskell+   -- - Not supported+   data Address+       = Post { postCode :: Text }+       | Full { fullStreet :: Text, fullHouse :: Int }++   ```+4. Sum types with more than 8 fields in at least one constructor are not+   supported.+   ```haskell+   -- - Not supported+   data Foo+       = Bar Int Text+       | Baz Int Int Text Text Double Double Bool Bool Char+   ```+5. Records with fields that reference the type itself are not supported. This+   limitation is due to the fact that `elm-street` generates `type alias` for+   record data type. So the generated Elm type for the following Haskell data+   type won't compile in Elm:+   ```haskell+   data User = User+       { userName      :: Text+       , userFollowers :: [User]+       }+   ```+6. Generated JSON encoders and decoders are consistent with default behavior of+   derived `ToJSON/FromJSON` instances from the `aeson` library except you need+   to strip record field prefixes. Fortunately, this also can be done+   generically. You can use functions from `Elm.Aeson` module to derive `JSON`+   instances from the `aeson` package.+7. Only `UTCTime` Haskell data type is supported and it's translated to `Posix`+   type in Elm.++## Play with frontend example++The `frontend` directory contains example of minimal Elm project that shows how+generated types are used. To play with this project, do:++1. Build and execute the `generate-elm` binary:+   ```+   cabal new-run generate-elm+   ```+2. Run Haskell backend:+   ```+   cabal new-run run-backend+   ```+3. In separate terminal tab go to the `frontend` folder:+   ```+   cd frontend+   ```+4. Run the frontend:+   ```+   elm-app start+   ```++## Generated examples++Below you can see some examples of how Haskell data types are converted to Elm+types with JSON encoders and decoders using the `elm-street` library.++### Records++**Haskell**++```haskell+data User = User+    { userName :: Text+    , userAge  :: Int+    } deriving (Generic)+      deriving anyclass (Elm)+```++**Elm**++```elm+type alias User =+    { name : String+    , age : Int+    }++encodeUser : User -> Value+encodeUser x = E.object+    [ ("name", E.string x.name)+    , ("age", E.int x.age)+    ]++decodeUser : Decoder User+decodeUser = D.succeed User+    |> required "name" D.string+    |> required "age" D.int+```++### Enums++**Haskell**++```haskell+data RequestStatus+    = Approved+    | Rejected+    | Reviewing+    deriving (Generic)+    deriving anyclass (Elm)+```++**Elm**++```elm+type RequestStatus+    = Approved+    | Rejected+    | Reviewing++showRequestStatus : RequestStatus -> String+showRequestStatus x = case x of+    Approved -> "Approved"+    Rejected -> "Rejected"+    Reviewing -> "Reviewing"++readRequestStatus : String -> Maybe RequestStatus+readRequestStatus x = case x of+    "Approved" -> Just Approved+    "Rejected" -> Just Rejected+    "Reviewing" -> Just Reviewing+    _ -> Nothing++universeRequestStatus : List RequestStatus+universeRequestStatus = [Approved, Rejected, Reviewing]++encodeRequestStatus : RequestStatus -> Value+encodeRequestStatus = E.string << showRequestStatus++decodeRequestStatus : Decoder RequestStatus+decodeRequestStatus = elmStreetDecodeEnum readRequestStatus+```++### Newtypes++**Haskell**++```haskell+newtype Age = Age+    { unAge :: Int+    } deriving (Generic)+      deriving anyclass (Elm)+```++**Elm**++```elm+type alias Age =+    { age : Int+    }++encodeAge : Age -> Value+encodeAge x = E.int x.age++decodeAge : Decoder Age+decodeAge = D.map Age D.int+```++### Newtypes with phantom types++**Haskell**++```haskell+newtype Id a = Id { unId :: Text }++instance Elm (Id a) where+    toElmDefinition _ = elmNewtype @Text "Id" "unId"+```++**Elm**++```elm+type alias Id =+    { unId : String+    }++encodeId : Id -> Value+encodeId x = E.string x.unId++decodeId : Decoder Id+decodeId = D.map Id D.string+```++### Sum types++**Haskell**++```haskell+data Guest+    = Regular Text Int+    | Visitor Text+    | Blocked+    deriving (Generic)+    deriving anyclass (Elm)+```++**Elm**++```elm+type Guest+    = Regular String Int+    | Visitor String+    | Blocked++encodeGuest : Guest -> Value+encodeGuest x = E.object <| case x of+    Regular x1 x2 -> [("tag", E.string "Regular"), ("contents", E.list identity [E.string x1, E.int x2])]+    Visitor x1 -> [("tag", E.string "Visitor"), ("contents", E.list identity [E.string x1])]+    Blocked  -> [("tag", E.string "Blocked"), ("contents", E.list identity [])]++decodeGuest : Decoder Guest+decodeGuest =+    let decide : String -> Decoder Guest+        decide x = case x of+            "Regular" -> D.field "contents" <| D.map2 Regular (D.index 0 D.string) (D.index 1 D.int)+            "Visitor" -> D.field "contents" <| D.map Visitor (D.index 0 D.string)+            "Blocked" -> D.succeed Blocked+            c -> D.fail <| "Guest doesn't have such constructor: " ++ c+    in D.andThen decide (D.field "tag" D.string)+```

@@ -0,0 +1,35 @@+{-# LANGUAGE DataKinds #-}++module Api+       ( app+       ) where++import Control.Monad.IO.Class (liftIO)+import Data.Proxy (Proxy (..))+import Network.Wai (Application)+import Servant.API ((:<|>) (..), (:>), Get, JSON, Post, ReqBody)+import Servant.Server (Handler, Server, serve)++import Types (OneType, defaultOneType)+++type TypesApi+    -- | Get 'OneType' from the backend side+       = "get" :> Get '[JSON] OneType+    -- | Receive 'OneType' from the frontend side+    :<|> "post" :> ReqBody '[JSON] OneType :> Post '[JSON] Bool++typesApi :: Proxy TypesApi+typesApi = Proxy++typesServer :: Server TypesApi+typesServer = getHandler :<|> postHandler++getHandler :: Handler OneType+getHandler = liftIO $ putStrLn "Get handler" >> pure defaultOneType++postHandler :: OneType -> Handler Bool+postHandler = liftIO . (putStrLn "Post handler" >>) . pure . (defaultOneType ==)++app :: Application+app = serve typesApi typesServer

@@ -0,0 +1,9 @@+module Main where++import Network.Wai.Handler.Warp (run)++import Api (app)+++main :: IO ()+main = run 8080 app

@@ -0,0 +1,199 @@+cabal-version:       2.0+name:                elm-street+version:             0.0.0+synopsis:            Crossing the road between Haskell and Elm+description:+    `Elm-street` allows you to generate automatically derived from Haskell types+    definitions of Elm data types, JSON encoders and decoders. This helps to avoid+    writing and maintaining huge chunk of boilerplate code when developing full-stack+    applications.+homepage:            https://github.com/Holmusk/elm-street+bug-reports:         https://github.com/Holmusk/elm-street/issues+license:             MPL-2.0+license-file:        LICENSE+author:              Holmusk+maintainer:          tech@holmusk.com+copyright:           2019 Holmusk+category:            Language, Compiler, Elm+build-type:          Simple+extra-doc-files:     README.md+                   , CHANGELOG.md+tested-with:         GHC == 8.4.4, GHC == 8.6.3++source-repository head+  type:                git+  location:            https://github.com/Holmusk/elm-street.git++library+  hs-source-dirs:      src+  exposed-modules:     Elm+                         Elm.Aeson+                         Elm.Ast+                         Elm.Generate+                         Elm.Generic+                         Elm.Print++  build-depends:       base >= 4.11.1.0 && < 4.13+                     , aeson >= 1.4+                     , directory ^>= 1.3+                     , filepath ^>= 1.4+                     , prettyprinter ^>= 1.2.1+                     , text ^>= 1.2+                     , time++  ghc-options:         -Wall+                       -Wincomplete-uni-patterns+                       -Wincomplete-record-updates+                       -Wcompat+                       -Widentities+                       -Wredundant-constraints+                       -fhide-source-paths+                       -Wmissing-export-lists+                       -Wpartial-fields++  default-language:    Haskell2010+  default-extensions:  ConstraintKinds+                       DeriveGeneric+                       GeneralizedNewtypeDeriving+                       InstanceSigs+                       KindSignatures+                       LambdaCase+                       OverloadedStrings+                       RecordWildCards+                       ScopedTypeVariables+                       StandaloneDeriving+                       TupleSections+                       TypeApplications+                       ViewPatterns++library types+  hs-source-dirs:      types+  exposed-modules:     Types++  build-depends:       base >= 4.11 && < 4.13+                     , aeson+                     , elm-street+                     , text+                     , time++  ghc-options:         -Wall+                       -Wincomplete-uni-patterns+                       -Wincomplete-record-updates+                       -Wcompat+                       -Widentities+                       -Wredundant-constraints+                       -fhide-source-paths+                       -Wmissing-export-lists+                       -Wpartial-fields++  default-language:    Haskell2010+  default-extensions:  ConstraintKinds+                       DeriveGeneric+                       GeneralizedNewtypeDeriving+                       InstanceSigs+                       KindSignatures+                       LambdaCase+                       OverloadedStrings+                       RecordWildCards+                       ScopedTypeVariables+                       StandaloneDeriving+                       TupleSections+                       TypeApplications+                       ViewPatterns++executable generate-elm+  hs-source-dirs:      generate-elm+  main-is:             Main.hs++  build-depends:       base+                     , elm-street+                     , types++  ghc-options:         -Wall+                       -threaded+                       -rtsopts+                       -with-rtsopts=-N+                       -Wincomplete-uni-patterns+                       -Wincomplete-record-updates+                       -Wcompat+                       -Widentities+                       -Wredundant-constraints+                       -fhide-source-paths++  default-language:    Haskell2010++executable run-backend+  hs-source-dirs:      backend+  main-is:             Main.hs+  other-modules:       Api++  build-depends:       base+                     , servant ^>= 0.15+                     , servant-server ^>= 0.15+                     , types+                     , wai ^>= 3.2.2+                     , warp ^>= 3.2++  ghc-options:         -Wall+                       -threaded+                       -rtsopts+                       -with-rtsopts=-N+                       -Wincomplete-uni-patterns+                       -Wincomplete-record-updates+                       -Wcompat+                       -Widentities+                       -Wredundant-constraints+                       -fhide-source-paths++  default-language:    Haskell2010+  default-extensions:  ConstraintKinds+                       DeriveGeneric+                       GeneralizedNewtypeDeriving+                       InstanceSigs+                       KindSignatures+                       LambdaCase+                       OverloadedStrings+                       RecordWildCards+                       ScopedTypeVariables+                       StandaloneDeriving+                       TupleSections+                       TypeApplications+                       TypeOperators+                       ViewPatterns++test-suite elm-street-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs++  build-depends:       base >= 4.11.1.0 && < 4.13+                     , elm-street+++  ghc-options:         -Wall+                       -threaded+                       -rtsopts+                       -with-rtsopts=-N+                       -Wincomplete-uni-patterns+                       -Wincomplete-record-updates+                       -Wcompat+                       -Widentities+                       -Wredundant-constraints+                       -fhide-source-paths+                       -Wmissing-export-lists+                       -Wpartial-fields++  default-language:    Haskell2010+  default-extensions:  ConstraintKinds+                       DeriveGeneric+                       GeneralizedNewtypeDeriving+                       InstanceSigs+                       KindSignatures+                       LambdaCase+                       OverloadedStrings+                       RecordWildCards+                       ScopedTypeVariables+                       StandaloneDeriving+                       TupleSections+                       TypeApplications+                       ViewPatterns

@@ -0,0 +1,15 @@+{-# LANGUAGE TypeApplications #-}++{- | Generates Elm types from Haskell @types@ internal library.++The generated files can be found in the @elm-example/src@ folder.+-}++module Main (main) where++import Elm (defaultSettings, generateElm)+import Types (Types)+++main :: IO ()+main = generateElm @Types $ defaultSettings "frontend/src" ["Core"]

@@ -0,0 +1,16 @@+{- | Library for generic conversion of data types from Haskell to Elm.+-}++module Elm+       ( module Elm.Aeson+       , module Elm.Ast+       , module Elm.Generate+       , module Elm.Generic+       , module Elm.Print+       ) where++import Elm.Aeson+import Elm.Ast+import Elm.Generate+import Elm.Generic+import Elm.Print

@@ -0,0 +1,165 @@+{-# LANGUAGE AllowAmbiguousTypes  #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE UndecidableInstances #-}++{- | Options used to derive FromJSON/ToJSON instance. These options generally+comply to @elm-street@ rules regarding names.+-}++module Elm.Aeson+       ( elmStreetParseJson+       , elmStreetToJson+       , elmStreetJsonOptions++       , ElmStreet (..)+       ) where++import Data.Aeson (FromJSON (..), GFromJSON, GToJSON, Options (..), ToJSON (..), Value, Zero,+                   defaultOptions, genericParseJSON, genericToJSON)+import Data.Aeson.Types (Parser)+import GHC.Generics (Generic, Rep)+import Type.Reflection (Typeable, typeRep)++import Elm.Ast (TypeName (..))+import Elm.Generic (Elm (..), GenericElmDefinition (..), HasLessThanEightUnnamedFields,+                    HasNoNamedSum, HasNoTypeVars, stripTypeNamePrefix)++import qualified Data.Text as T+import qualified GHC.Generics as Generic (from)+++{- | Allows to create 'Data.Aeson.FromJSON' instance that strips the supported+by @elm-street@ data type name prefix from every field..++__Example:__++With the following @JSON@++@+{ \"name\": \"John\"+, \"age\": 42+}+@++it is decoded it the following way for each of the specified types:+++-------------------------------+--------------------------++| Haskell data type             | Parsed type              |++===============================+==========================++| @                             | @                        |+| data User = User              | User                     |+| \   { userName :: String      |    { userName = \"John\" |+| \   , userAge  :: Int         |    , userAge  = 42       |+| \   }                         |    }                     |+| @                             | @                        |++-------------------------------+--------------------------++|                               |                          |+| @                             | @                        |+| data LongUser = LongUser      | LongUser                 |+|    { luName :: String         |    { luName = \"John\"   |+|    , luAge  :: Int            |    , luAge  = 42         |+|    }                          |    }                     |+| @                             | @                        |++-------------------------------+--------------------------++| @                             | @                        |+| data SimpleUser = SimpleUser  | SimpleUser               |+|    { name :: String           |    { name = \"John\"     |+|    , age  :: Int              |    , age  = 42           |+|    }                          |    }                     |+| @                             | @                        |++-------------------------------+--------------------------+++>>> data User = User { userName :: String, userAge :: Int } deriving (Generic, Show)+>>> instance FromJSON User where parseJSON = elmStreetParseJson+>>> decode @User "{ \"name\": \"John\", \"age\": 42 }"+Just (User {userName = "John", userAge = 42})+++>>> data VeryLongType = VeryLongType { vltName :: String, vltAge :: Int } deriving (Generic, Show)+>>> instance FromJSON VeryLongType where parseJSON = elmStreetParseJson+>>> decode @VeryLongType "{ \"name\": \"John\", \"age\": 42 }"+Just (VeryLongType {vltName = "John", vltAge = 42})++-}+elmStreetParseJson+    :: forall a .+       (Typeable a, Generic a, GFromJSON Zero (Rep a))+    => Value+    -> Parser a+elmStreetParseJson = genericParseJSON (elmStreetJsonOptions @a)++{- | Allows to create 'Data.Aeson.ToJSON' instance that strips the supported by+@elm-street@ data type name prefix from every field.++>>> data User = User { userName :: String, userAge :: Int } deriving (Generic, Show)+>>> instance ToJSON User where toJSON = elmStreetToJson+>>> encode $ User { userName = "John", userAge = 42 }+"{\"age\":42,\"name\":\"John\"}"++>>> data VeryLongType = VeryLongType { vltName :: String, vltAge :: Int } deriving (Generic, Show)+>>> instance ToJSON VeryLongType where toJSON = elmStreetToJson+>>> encode $ VeryLongType {vltName = "John", vltAge = 42}+"{\"age\":42,\"name\":\"John\"}"++>>> data User = User { name :: String, age :: Int } deriving (Generic, Show)+>>> instance ToJSON User where toJSON = elmStreetToJson+>>> encode $ User { name = "John", age = 42 }+"{\"age\":42,\"name\":\"John\"}"+-}+elmStreetToJson+    :: forall a .+       (Typeable a, Generic a, GToJSON Zero (Rep a))+    => a+    -> Value+elmStreetToJson = genericToJSON (elmStreetJsonOptions @a)++{- | Options to strip type name from the field names.+++----------------+----------------+---------------------++| Data type name | Field name     | Stripped field name |++================+================+=====================++| @User@         | @userName@     | @name@              |++----------------+----------------+---------------------++| @AaaBbbCcc@    | @abcFieldName@ | @fieldName@         |++----------------+----------------+---------------------++| @Foo@          | @field@        | @field@             |++----------------+----------------+---------------------++| @Field@        | @field@        | @field@             |++----------------+----------------+---------------------+++-}+elmStreetJsonOptions :: forall a . Typeable a => Options+elmStreetJsonOptions = defaultOptions+    { fieldLabelModifier = T.unpack . stripTypeNamePrefix typeName . T.pack+    }+  where+    typeName :: TypeName+    typeName = TypeName $ T.pack $ show $ typeRep @a+++{- | Newtype for reusing in @DerivingVia@.++In order to use it with your type @MyType@ add the following deriving to your type:++@+    __deriving__ (Elm, ToJSON, FromJSON) __via__ ElmStreet MyType+@+-}+newtype ElmStreet a = ElmStreet+    { unElmStreet :: a+    }++instance ( HasNoTypeVars a+         , HasLessThanEightUnnamedFields a+         , HasNoNamedSum a+         , Generic a+         , GenericElmDefinition (Rep a)+         ) => Elm (ElmStreet a) where+    toElmDefinition _ = genericToElmDefinition+        $ Generic.from (error "Proxy for generic elm was evaluated" :: a)++instance (Typeable a, Generic a, GToJSON Zero (Rep a)) => ToJSON (ElmStreet a) where+    toJSON = elmStreetToJson . unElmStreet++instance (Typeable a, Generic a, GFromJSON Zero (Rep a)) => FromJSON (ElmStreet a) where+    parseJSON = fmap ElmStreet . elmStreetParseJson

@@ -0,0 +1,100 @@+{- | AST representing structure of Elm types. Haskell generic representation is+converted to this AST which later is going to be pretty-printed.+-}++module Elm.Ast+       ( ElmDefinition (..)++       , ElmAlias (..)+       , ElmType (..)+       , ElmPrim (..)++       , ElmRecordField (..)+       , ElmConstructor (..)+       , isEnum+       , getConstructorNames++       , TypeName (..)+       , TypeRef (..)+       , definitionToRef+       ) where++import Data.List.NonEmpty (NonEmpty, toList)+import Data.Text (Text)+++-- | Elm data type definition.+data ElmDefinition+    = DefAlias !ElmAlias+    | DefType  !ElmType+    | DefPrim  !ElmPrim+    deriving (Show)++-- | AST for @type alias@ in Elm.+data ElmAlias = ElmAlias+    { elmAliasName      :: !Text  -- ^ Name of the alias+    , elmAliasFields    :: !(NonEmpty ElmRecordField)  -- ^ List of fields+    , elmAliasIsNewtype :: !Bool  -- ^ 'True' if Haskell type is a @newtype@+    } deriving (Show)++-- | Single file of @type alias@.+data ElmRecordField = ElmRecordField+    { elmRecordFieldType :: !TypeRef+    , elmRecordFieldName :: !Text+    } deriving (Show)++-- | Wrapper for name of the type.+newtype TypeName = TypeName+    { unTypeName :: Text+    } deriving (Show)++-- | AST for @type@ in Elm.+data ElmType = ElmType+    { elmTypeName         :: !Text  -- ^ Name of the data type+    , elmTypeVars         :: ![Text]  -- ^ List of type variables; currently only phantom variables+    , elmTypeIsNewtype    :: !Bool  -- ^ 'True' if Haskell type is a @newtype@+    , elmTypeConstructors :: !(NonEmpty ElmConstructor)  -- ^ List of constructors+    } deriving (Show)++-- | Constructor of @type@.+data ElmConstructor = ElmConstructor+    { elmConstructorName   :: !Text  -- ^ Name of the constructor+    , elmConstructorFields :: ![TypeRef]  -- ^ Fields of the constructor+    } deriving (Show)++-- | Checks if the given 'ElmType' is Enum.+isEnum :: ElmType -> Bool+isEnum ElmType{..} = null elmTypeVars && null (foldMap elmConstructorFields elmTypeConstructors)++-- | Gets the list of the constructor names.+getConstructorNames :: ElmType -> [Text]+getConstructorNames ElmType{..} = map elmConstructorName $ toList elmTypeConstructors++-- | Primitive elm types; hardcoded by the language.+data ElmPrim+    = ElmUnit                      -- ^ @()@ type in elm+    | ElmNever                     -- ^ @Never@ type in elm, analogous to Void in Haskell+    | ElmBool                      -- ^ @Bool@+    | ElmChar                      -- ^ @Char@+    | ElmInt                       -- ^ @Int@+    | ElmFloat                     -- ^ @Float@+    | ElmString                    -- ^ @String@+    | ElmTime                      -- ^ @Posix@ in elm, @UTCTime@ in Haskell+    | ElmMaybe !TypeRef            -- ^ @Maybe T@+    | ElmResult !TypeRef !TypeRef  -- ^ @Result A B@ in elm+    | ElmPair !TypeRef !TypeRef    -- ^ @(A, B)@ in elm+    | ElmList !TypeRef             -- ^ @List A@ in elm+    deriving (Show)++-- | Reference to another existing type.+data TypeRef+    = RefPrim !ElmPrim+    | RefCustom !TypeName+    deriving (Show)++-- | Extracts reference to the existing data type type from some other type elm defintion.+definitionToRef :: ElmDefinition -> TypeRef+definitionToRef = \case+    DefAlias ElmAlias{..} -> RefCustom $ TypeName elmAliasName+    DefType ElmType{..} -> RefCustom $ TypeName elmTypeName+    DefPrim elmPrim -> RefPrim elmPrim

@@ -0,0 +1,168 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds           #-}+{-# LANGUAGE GADTs               #-}+{-# LANGUAGE TypeOperators       #-}++module Elm.Generate+       ( Settings (..)+       , defaultSettings+       , generateElm++         -- * Internal helpers+       , RenderElm (..)+       ) where++import Data.Kind (Type)+import Data.List (intercalate)+import Data.Proxy (Proxy (..))+import Data.Text (Text)+import System.Directory (createDirectoryIfMissing)+import System.FilePath ((<.>), (</>))++import Elm.Generic (Elm (..))+import Elm.Print (decodeChar, decodeEither, decodeEnum, decodePair, encodeEither, encodeMaybe,+                  encodePair, prettyShowDecoder, prettyShowDefinition, prettyShowEncoder)++import qualified Data.Text as T+import qualified Data.Text.IO as TIO+++-- | Settings for outputting generated Elm code.+data Settings = Settings+    { settingsDirectory   :: !FilePath    -- ^ Directory to put generated files, e.g. @frontend\/src@+    , settingsModule      :: ![FilePath]  -- ^ List of module parts, like @["ABC", "Core"]@+    , settingsTypesFile   :: !FilePath    -- ^ File name for module with types, e.g. @Types@+    , settingsEncoderFile :: !FilePath    -- ^ File name for module with JSON encoders, e.g. @Encoder@+    , settingsDecoderFile :: !FilePath    -- ^ File name for module with JSON decoders, e.g. @Decoder@+    }++{- | Default settings for generating Elm definitions. You only need to pass name+of the directory and module path prefix. Other settings parameters set to:++1. 'settingsTypesFile': @Types@+2. 'settingsEncoderFile': @Encoder@+3. 'settingsDecoderFile': @Decoder@+-}+defaultSettings :: FilePath -> [FilePath] -> Settings+defaultSettings settingsDirectory settingsModule = Settings+    { settingsTypesFile   = "Types"+    , settingsEncoderFile = "Encoder"+    , settingsDecoderFile = "Decoder"+    , ..+    }++-- | Typeclass for generating elm definitions for the list of types.+class RenderElm (types :: [Type]) where+    renderType    :: [Text]+    renderEncoder :: [Text]+    renderDecoder :: [Text]++instance RenderElm '[] where+    renderType    = []+    renderEncoder = []+    renderDecoder = []++instance (Elm t, RenderElm ts) => RenderElm (t ': ts) where+    renderType    = "" : toElmTypeSource    @t : renderType    @ts+    renderEncoder = "" : toElmEncoderSource @t : renderEncoder @ts+    renderDecoder = "" : toElmDecoderSource @t : renderDecoder @ts++toElmTypeSource :: forall a . Elm a => Text+toElmTypeSource = prettyShowDefinition $ toElmDefinition $ Proxy @a++toElmEncoderSource :: forall a . Elm a => Text+toElmEncoderSource = prettyShowEncoder $ toElmDefinition $ Proxy @a++toElmDecoderSource :: forall a . Elm a => Text+toElmDecoderSource = prettyShowDecoder $ toElmDefinition $ Proxy @a++{- | Generate elm definitions for the list of types. This function is supposed+to be called like this:++@+__type__ Types =+   '[ User+    , UserStatus+    , Measure+    ]++main :: IO ()+main = generateElm @Types $ defaultSettings "frontend\/src\/" ["ABC", "Core"]+@+-}+generateElm :: forall (ts :: [Type]) . RenderElm ts => Settings -> IO ()+generateElm Settings{..} = do+    createDirectoryIfMissing True fullPath++    writeElm settingsTypesFile   $ typesHeader   : renderType    @ts+    writeElm settingsEncoderFile $ encoderHeader : renderEncoder @ts+    writeElm settingsDecoderFile $ decoderHeader : renderDecoder @ts++    writeElm "ElmStreet" elmStreetDefinitions+  where+    moduleDir, fullPath :: FilePath+    moduleDir = foldr (</>) "" settingsModule+    fullPath  = settingsDirectory </> moduleDir++    writeElm :: FilePath -> [Text] -> IO ()+    writeElm file defs = TIO.writeFile (fullPath </> file <.> "elm") (T.unlines defs)++    joinModule :: [String] -> Text+    joinModule = T.pack . intercalate "."++    typesModule, encoderModule, decoderModule :: Text+    typesModule   = joinModule $ settingsModule ++ [settingsTypesFile]+    encoderModule = joinModule $ settingsModule ++ [settingsEncoderFile]+    decoderModule = joinModule $ settingsModule ++ [settingsDecoderFile]+    streetModule  = joinModule $ settingsModule ++ ["ElmStreet"]++    typesHeader :: Text+    typesHeader = T.unlines+        [ "module " <> typesModule <> " exposing (..)"+        , ""+        , "import Time exposing (Posix)"+        ]++    encoderHeader :: Text+    encoderHeader = T.unlines+        [ "module " <> encoderModule <> " exposing (..)"+        , ""+        , "import Iso8601 as Iso"+        , "import Json.Encode as E exposing (..)"+        , ""+        , "import " <> streetModule <> " exposing (..)"+        , "import " <> typesModule <> " exposing (..)"+        ]++    decoderHeader :: Text+    decoderHeader = T.unlines+        [ "module " <> decoderModule <> " exposing (..)"+        , ""+        , "import Iso8601 as Iso"+        , "import Json.Decode as D exposing (..)"+        , "import Json.Decode.Pipeline as D exposing (required)"+        , ""+        , "import " <> streetModule <> " exposing (..)"+        , "import " <> typesModule <> " exposing (..)"+        ]++    elmStreetDefinitions :: [Text]+    elmStreetDefinitions =+        [ "module " <> streetModule <> " exposing (..)"+        , ""+        , "import Json.Encode as E exposing (Value)"+        , "import Json.Decode as D exposing (Decoder)"+        , "import Json.Decode.Pipeline as D exposing (..)"+        , ""+        , ""+        , encodeMaybe+        , encodeEither+        , encodePair++        , decodeEnum+        , decodeChar+        , decodeEither+        , decodePair+        ]

@@ -0,0 +1,378 @@+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}++{-# LANGUAGE AllowAmbiguousTypes  #-}+{-# LANGUAGE DataKinds            #-}+{-# LANGUAGE DefaultSignatures    #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE PolyKinds            #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE UndecidableInstances #-}++{- | Generic conversion of Haskell data types to Elm types.+-}++module Elm.Generic+       ( -- * Main data type for the user+         Elm (..)+       , elmRef++         -- * Smart constructors+       , elmNewtype++         -- * Generic utilities+       , GenericElmDefinition (..)+       , GenericElmConstructors (..)+       , GenericElmFields (..)++       , GenericConstructor (..)+       , toElmConstructor++         -- * Type families for compile-time checks+       , HasNoTypeVars+       , TypeVarsError++       , HasLessThanEightUnnamedFields+       , FieldsError+       , CheckFields+       , Max++       , HasNoNamedSum+       , NamedSumError+       , CheckNamedSum+       , CheckConst++         -- * Internals+       , stripTypeNamePrefix+       ) where++import Data.Char (isLower, toLower)+import Data.Int (Int16, Int32, Int8)+import Data.Kind (Constraint, Type)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Proxy (Proxy (..))+import Data.Text (Text)+import Data.Time.Clock (UTCTime)+import Data.Type.Bool (If, type (||))+import Data.Void (Void)+import Data.Word (Word16, Word32, Word8)+import GHC.Generics ((:*:), (:+:), C1, Constructor (..), D1, Datatype (..), Generic (..), M1 (..), Meta (..),+                     Rec0, S1, Selector (..), U1)+import GHC.TypeLits (ErrorMessage (..), Nat, TypeError)+import GHC.TypeNats (type (<=?), type (+))++import Elm.Ast (ElmAlias (..), ElmConstructor (..), ElmDefinition (..), ElmPrim (..),+                ElmRecordField (..), ElmType (..), TypeName (..), TypeRef (..), definitionToRef)++import qualified Data.Text as T+import qualified Data.Text.Lazy as LT (Text)+import qualified GHC.Generics as Generic (from)+++{- | Typeclass that describes how Haskell data types are converted to Elm ones.+-}+class Elm a where+    toElmDefinition :: Proxy a -> ElmDefinition++    default toElmDefinition+        :: ( HasNoTypeVars a+           , HasLessThanEightUnnamedFields a+           , HasNoNamedSum a+           , Generic a+           , GenericElmDefinition (Rep a)+           )+        => Proxy a+        -> ElmDefinition+    toElmDefinition _ = genericToElmDefinition+        $ Generic.from (error "Proxy for generic elm was evaluated" :: a)++{- | Returns 'TypeRef' for the existing type. This function always returns the+name of the type without any type variables added.+-}+elmRef :: forall a . Elm a => TypeRef+elmRef = definitionToRef $ toElmDefinition $ Proxy @a++----------------------------------------------------------------------------+-- Primitive instances+----------------------------------------------------------------------------++instance Elm ()   where toElmDefinition _ = DefPrim ElmUnit+instance Elm Void where toElmDefinition _ = DefPrim ElmNever+instance Elm Bool where toElmDefinition _ = DefPrim ElmBool+instance Elm Char where toElmDefinition _ = DefPrim ElmChar++instance Elm Int    where toElmDefinition _ = DefPrim ElmInt+instance Elm Int8   where toElmDefinition _ = DefPrim ElmInt+instance Elm Int16  where toElmDefinition _ = DefPrim ElmInt+instance Elm Int32  where toElmDefinition _ = DefPrim ElmInt+instance Elm Word   where toElmDefinition _ = DefPrim ElmInt+instance Elm Word8  where toElmDefinition _ = DefPrim ElmInt+instance Elm Word16 where toElmDefinition _ = DefPrim ElmInt+instance Elm Word32 where toElmDefinition _ = DefPrim ElmInt++instance Elm Float  where toElmDefinition _ = DefPrim ElmFloat+instance Elm Double where toElmDefinition _ = DefPrim ElmFloat++instance {-# OVERLAPPING #-} Elm String where toElmDefinition _ = DefPrim ElmString++instance Elm Text    where toElmDefinition _ = DefPrim ElmString+instance Elm LT.Text where toElmDefinition _ = DefPrim ElmString++-- TODO: should it be 'Bytes' from @bytes@ package?+-- https://package.elm-lang.org/packages/elm/bytes/latest/Bytes+-- instance Elm B.ByteString  where toElmDefinition _ = DefPrim ElmString+-- instance Elm LB.ByteString where toElmDefinition _ = DefPrim ElmString++instance Elm UTCTime where toElmDefinition _ = DefPrim ElmTime++instance Elm a => Elm (Maybe a) where+    toElmDefinition _ = DefPrim $ ElmMaybe $ elmRef @a++instance (Elm a, Elm b) => Elm (Either a b) where+    toElmDefinition _ = DefPrim $ ElmResult (elmRef @a) (elmRef @b)++instance (Elm a, Elm b) => Elm (a, b) where+    toElmDefinition _ = DefPrim $ ElmPair (elmRef @a) (elmRef @b)++instance Elm a => Elm [a] where+    toElmDefinition _ = DefPrim $ ElmList (elmRef @a)++instance Elm a => Elm (NonEmpty a) where+    toElmDefinition _ = DefPrim $ ElmList (elmRef @a)++----------------------------------------------------------------------------+-- Smart constructors+----------------------------------------------------------------------------++{- | This function can be used to create manual 'Elm' instances easily for+@newtypes@ where 'Generic' deriving doesn't work. This function can be used like+this:++@+__newtype__ Id a = Id { unId :: Text }++__instance__ Elm (Id a) __where__+    toElmDefinition _ = elmNewtype @Text "Id" "unId"+@+-}+elmNewtype :: forall a . Elm a => Text -> Text -> ElmDefinition+elmNewtype typeName fieldName = DefAlias $ ElmAlias+    { elmAliasName      = typeName+    , elmAliasFields    = ElmRecordField (elmRef @a) fieldName :| []+    , elmAliasIsNewtype = True+    }++----------------------------------------------------------------------------+-- Generic instances+----------------------------------------------------------------------------++{- | Generic typeclass to generate whole 'ElmDefinition'. It has only one+instance: for the first top-level metadata that contains metainformation about+data type like @data type name@. Then it collects all constructors of the data+type and decides what to generate.+-}+class GenericElmDefinition (f :: k -> Type) where+    genericToElmDefinition :: f a -> ElmDefinition++instance (Datatype d, GenericElmConstructors f) => GenericElmDefinition (D1 d f) where+    genericToElmDefinition datatype = case genericToElmConstructors (TypeName typeName) (unM1 datatype) of+        c :| [] -> case toElmConstructor c of+            Left fields -> DefAlias $ ElmAlias typeName fields elmIsNewtype+            Right ctor  -> DefType $ ElmType typeName [] elmIsNewtype (ctor :| [])+        c :| cs -> case traverse (rightToMaybe . toElmConstructor) (c :| cs) of+            -- TODO: this should be error but dunno what to do here+            Nothing    -> DefType $ ElmType ("ERROR_" <> typeName) [] False (ElmConstructor "ERROR" [] :| [])+            Just ctors -> DefType $ ElmType typeName [] elmIsNewtype ctors+      where+        typeName :: Text+        typeName = T.pack $ datatypeName datatype++        elmIsNewtype :: Bool+        elmIsNewtype = isNewtype datatype++rightToMaybe :: Either l r -> Maybe r+rightToMaybe = either (const Nothing) Just++{- | Intermediate data type to help with the conversion from Haskell+constructors to Elm AST. In Haskell constructor fields may have names but may+not have.+-}+data GenericConstructor = GenericConstructor+    { genericConstructorName   :: !Text+    , genericConstructorFields :: ![(TypeRef, Maybe Text)]+    }++{- | Generic constructor can be in one of the three states:++1. No fields: enum constructor.+2. All fields have names: record constructor.+3. Not all fields have names: plain constructor.+-}+toElmConstructor :: GenericConstructor -> Either (NonEmpty ElmRecordField) ElmConstructor+toElmConstructor GenericConstructor{..} = case genericConstructorFields of+    []   -> Right $ ElmConstructor genericConstructorName []+    f:fs -> case traverse toRecordField (f :| fs) of+        Nothing     -> Right $ ElmConstructor genericConstructorName $ map fst genericConstructorFields+        Just fields -> Left fields+  where+    toRecordField :: (TypeRef, Maybe Text) -> Maybe ElmRecordField+    toRecordField (typeRef, maybeFieldName) = ElmRecordField typeRef <$> maybeFieldName+++{- | Typeclass to collect all constructors of the Haskell data type generically. -}+class GenericElmConstructors (f :: k -> Type) where+    genericToElmConstructors+        :: TypeName  -- ^ Name of the data type; to be stripped+        -> f a  -- ^ Generic value+        -> NonEmpty GenericConstructor  -- ^ List of the data type constructors++-- | If it's a sum type then just combine constructors+instance (GenericElmConstructors f, GenericElmConstructors g) => GenericElmConstructors (f :+: g) where+    genericToElmConstructors name _ =+        genericToElmConstructors name (error "'f :+:' is evaluated" :: f p)+     <> genericToElmConstructors name (error "':+: g' is evaluated" :: g p)++-- | Create singleton list for case of a one constructor.+instance (Constructor c, GenericElmFields f) => GenericElmConstructors (C1 c f) where+    genericToElmConstructors name constructor = pure $ GenericConstructor+        (T.pack $ conName constructor)+        (genericToElmFields name $ unM1 constructor)++-- | Collect all fields when inside constructor.+class GenericElmFields (f :: k -> Type) where+    genericToElmFields+        :: TypeName  -- ^ Name of the data type; to be stripped+        -> f a  -- ^ Generic value+        -> [(TypeRef, Maybe Text)]++-- | If multiple fields then just combine all results.+instance (GenericElmFields f, GenericElmFields g) => GenericElmFields (f :*: g) where+    genericToElmFields name _ =+        genericToElmFields name (error "'f :*:' is evaluated" :: f p)+     <> genericToElmFields name (error "':*: g' is evaluated" :: g p)++-- | Constructor without fields.+instance GenericElmFields U1 where+    genericToElmFields _ _ = []++-- | Single constructor field.+instance (Selector s, Elm a) => GenericElmFields (S1 s (Rec0 a)) where+    genericToElmFields typeName selector = case selName selector of+        ""   -> [(elmRef @a, Nothing)]+        name -> [(elmRef @a, Just $ stripTypeNamePrefix typeName $ T.pack name)]++{- | Strips name of the type name from field name prefix.++>>> stripTypeNamePrefix (TypeName "User") "userName"+"name"++>>> stripTypeNamePrefix (TypeName "HealthReading") "healthReadingId"+"id"++>>> stripTypeNamePrefix (TypeName "RecordUpdate") "ruRows"+"rows"++>>> stripTypeNamePrefix (TypeName "Foo") "foo"+"foo"++>>> stripTypeNamePrefix (TypeName "Foo") "abc"+"abc"+-}+stripTypeNamePrefix :: TypeName -> Text -> Text+stripTypeNamePrefix (TypeName typeName) fieldName =+    case T.stripPrefix (headToLower typeName) fieldName of+        Just rest -> leaveIfEmpty rest+        Nothing   -> leaveIfEmpty (T.dropWhile isLower fieldName)+  where+    headToLower :: Text -> Text+    headToLower t = case T.uncons t of+        Nothing      -> error "Cannot use 'headToLower' on empty Text"+        Just (x, xs) -> T.cons (toLower x) xs++    -- if all lower case then leave field as it is+    leaveIfEmpty :: Text -> Text+    leaveIfEmpty rest = if T.null rest then fieldName else headToLower rest++----------------------------------------------------------------------------+-- ~Magic~+----------------------------------------------------------------------------++{- | This type family checks whether data type has type variables and throws+custom compiler error if it has. Since there's no generic way to get all type+variables, current implementation is limited only to 6 variables. This looks+like a reasonable number.+-}+type family HasNoTypeVars (f :: k) :: Constraint where+    HasNoTypeVars (t a b c d e f) = TypeError (TypeVarsError t 6)+    HasNoTypeVars (t a b c d e)   = TypeError (TypeVarsError t 5)+    HasNoTypeVars (t a b c d)     = TypeError (TypeVarsError t 4)+    HasNoTypeVars (t a b c)       = TypeError (TypeVarsError t 3)+    HasNoTypeVars (t a b)         = TypeError (TypeVarsError t 2)+    HasNoTypeVars (t a)           = TypeError (TypeVarsError t 1)+    HasNoTypeVars t               = ()++type family TypeVarsError (t :: k) (n :: Nat) :: ErrorMessage where+    TypeVarsError t n =+             'Text "'elm-street' currently doesn't support Generic deriving of the 'Elm' typeclass"+        ':$$: 'Text "for data types with type variables. But '"+              ':<>: 'ShowType t ':<>: 'Text "' has " ':<>: 'ShowType n ':<>: 'Text " variables."+        ':$$: 'Text ""+        ':$$: 'Text "See the following issue for more details:"+        ':$$: 'Text "    * https://github.com/Holmusk/elm-street/issues/45"+        ':$$: 'Text ""++{- | This type family checks whether each constructor of the sum data type has+less than eight unnamed fields and throws custom compiler error if it has.+-}+type family HasLessThanEightUnnamedFields (f :: k) :: Constraint where+    HasLessThanEightUnnamedFields t =+        If (CheckFields (Rep t) <=? 8)+            (() :: Constraint)+            (TypeError (FieldsError t))++type family CheckFields (f :: k -> Type) :: Nat where+    CheckFields (D1 _ f) = CheckFields f+    CheckFields (f :+: g) = Max (CheckFields f) (CheckFields g)+    CheckFields (C1 _ f) = CheckFields f+    CheckFields (f :*: g) = CheckFields f + CheckFields g+    CheckFields (S1 ('MetaSel ('Just _ ) _ _ _) _) = 0+    CheckFields (S1 _ _) = 1+    CheckFields _ = 0++type family Max (x :: Nat) (y :: Nat) :: Nat where+    Max x y = If (x <=? y) y x++type family FieldsError (t :: k) :: ErrorMessage where+    FieldsError t =+             'Text "'elm-street' doesn't support Constructors with more than 8 unnamed fields."+        ':$$: 'Text "But '" ':<>: 'ShowType t ':<>: 'Text "' has more."++{- | This type family checks whether each constructor of the sum data type has+less than eight unnamed fields and throws custom compiler error if it has.+-}+type family HasNoNamedSum (f :: k) :: Constraint where+    HasNoNamedSum t =+        If (CheckNamedSum (Rep t))+            (TypeError (NamedSumError t))+            (() :: Constraint)++-- | Is the data type id Sum type with named fields?+type family CheckNamedSum (f :: k -> Type) :: Bool where+    CheckNamedSum (D1 _ f) = CheckNamedSum f+    CheckNamedSum (f :+: g) = CheckConst f || CheckConst g+    CheckNamedSum _ = 'False++-- | Check if Sum type has named fields at least for one of the Constructors.+type family CheckConst (f :: k -> Type) :: Bool where+    CheckConst (f :+: g) = CheckConst f || CheckConst g+    CheckConst (C1 _ f) = CheckConst f+    CheckConst (S1 ('MetaSel ('Just _ ) _ _ _) _) = 'True+    CheckConst (f :*: g) = CheckConst f || CheckConst g+    CheckConst _ = 'False++type family NamedSumError (t :: k) :: ErrorMessage where+    NamedSumError t =+             'Text "'elm-street' doesn't support Sum types with records."+        ':$$: 'Text "But '" ':<>: 'ShowType t ':<>: 'Text "' has records."

@@ -0,0 +1,675 @@+{- | This module defines prettyprinter for 'ElmDefinition' type.+and exports the function to represent it in the convenient way.+-}++module Elm.Print+       ( prettyShowDefinition+       , prettyShowEncoder+       , prettyShowDecoder++         -- * Standard missing encoders+       , encodeMaybe+       , encodeEither+       , encodePair++         -- * Standard missing decoders+       , decodeEnum+       , decodeChar+       , decodeEither+       , decodePair++         -- * Internal functions+       , elmAliasDoc+       , elmTypeDoc+       ) where++import Data.List.NonEmpty (NonEmpty ((:|)), toList)+import Data.Text (Text)+import Data.Text.Prettyprint.Doc (Doc, brackets, colon, comma, concatWith, dquotes, emptyDoc,+                                  equals, lbrace, lbracket, line, lparen, nest, parens, pipe,+                                  pretty, prettyList, rbrace, rbracket, rparen, sep, space,+                                  surround, vsep, (<+>))++import Elm.Ast (ElmAlias (..), ElmConstructor (..), ElmDefinition (..), ElmPrim (..),+                ElmRecordField (..), ElmType (..), TypeName (..), TypeRef (..), getConstructorNames,+                isEnum)++import qualified Data.List.NonEmpty as NE+import qualified Data.Text as T+++{- | Pretty shows Elm types.++* See 'elmAliasDoc' for examples of generated @type alias@.+* See 'elmTypeDoc' for examples of generated @type@.+-}+prettyShowDefinition :: ElmDefinition -> Text+prettyShowDefinition = showDoc . elmDoc++showDoc :: Doc ann -> Text+showDoc = T.pack . show++elmDoc :: ElmDefinition -> Doc ann+elmDoc = \case+    DefAlias elmAlias -> elmAliasDoc elmAlias+    DefType elmType -> elmTypeDoc elmType+    DefPrim _ -> emptyDoc++-- | Pretty printer for type reference.+elmTypeRefDoc :: TypeRef -> Doc ann+elmTypeRefDoc = \case+    RefPrim elmPrim -> elmPrimDoc elmPrim+    RefCustom (TypeName typeName) -> pretty typeName++{- | Pretty printer for primitive Elm types. This pretty printer is used only to+display types of fields.+-}+elmPrimDoc :: ElmPrim -> Doc ann+elmPrimDoc = \case+    ElmUnit       -> "()"+    ElmNever      -> "Never"+    ElmBool       -> "Bool"+    ElmChar       -> "Char"+    ElmInt        -> "Int"+    ElmFloat      -> "Float"+    ElmString     -> "String"+    ElmTime       -> "Posix"+    ElmMaybe t    -> "Maybe" <+> elmTypeParenDoc t+    ElmResult l r -> "Result" <+> elmTypeParenDoc l <+> elmTypeParenDoc r+    ElmPair a b   -> lparen <> elmTypeRefDoc a <> comma <+> elmTypeRefDoc b <> rparen+    ElmList l     -> "List" <+> elmTypeParenDoc l++{- | Pretty-printer for types. Adds parens for both sides when needed (when type+contains of multiple words).+-}+elmTypeParenDoc :: TypeRef -> Doc ann+elmTypeParenDoc = wrapParens . elmTypeRefDoc++{- | Wraps given document in parens if it contains more than single word.+-}+wrapParens :: Doc ann -> Doc ann+wrapParens = wordsDoc . T.words . showDoc+  where+    wordsDoc :: [Text] -> Doc ann+    wordsDoc = \case+        []  -> ""+        [x] -> pretty x+        xs  -> lparen <> pretty (T.unwords xs) <> rparen++{- | Pretty printer for Elm aliases:++@+type alias User =+    { userHeh : String+    , userMeh : Int+    }+@+-}+elmAliasDoc :: ElmAlias -> Doc ann+elmAliasDoc ElmAlias{..} = nest 4 $+    vsep $ ("type alias" <+> pretty elmAliasName <+> equals)+         : fieldsDoc elmAliasFields+  where+    fieldsDoc :: NonEmpty ElmRecordField -> [Doc ann]+    fieldsDoc (fstR :| rest) =+        lbrace <+> recordFieldDoc fstR+      : map ((comma <+>) . recordFieldDoc) rest+     ++ [rbrace]++    recordFieldDoc :: ElmRecordField -> Doc ann+    recordFieldDoc ElmRecordField{..} =+            pretty elmRecordFieldName+        <+> colon+        <+> elmTypeRefDoc elmRecordFieldType++{- | Pretty printer for Elm types with one or more constructors:++@+type Status a+    = Foo String Int+    | Bar a+    | Baz+@++If the type is a newtype then additionally @unTYPENAME@ function is generated:++@+type Id a+    = Id String++unId : Id a -> String+unId (Id x) = x+@++If the type is Enum this function will add enum specific functions:++@+type Status+    = Approved+    | Yoyoyo+    | Wow++showStatus : Status -> String+showStatus x = case x of+    Approved -> "Approved"+    Yoyoyo -> "Yoyoyo"+    Wow -> "Wow"++readStatus : String -> Maybe Status+readStatus x = case x of+    "Approved" -> Just Approved+    "Yoyoyo" -> Just Yoyoyo+    "Wow" -> Just Wow+    _ -> Nothing++universeStatus : List Status+universeStatus = [Approved, Yoyoyo, Wow]+@+-}+elmTypeDoc :: ElmType -> Doc ann+elmTypeDoc t@ElmType{..} =+    nest 4 ( vsep $ ("type" <+> pretty elmTypeName <> sepVars)+                  : constructorsDoc elmTypeConstructors+           )+    <> unFunc+    <> enumFuncs+  where+    sepVars :: Doc ann+    sepVars = case elmTypeVars of+        []   -> emptyDoc+        vars -> space <> sep (map pretty vars)++    constructorsDoc :: NonEmpty ElmConstructor -> [Doc ann]+    constructorsDoc (fstC :| rest) =+        equals <+> constructorDoc fstC+        : map ((pipe <+>) . constructorDoc) rest++    constructorDoc :: ElmConstructor -> Doc ann+    constructorDoc ElmConstructor{..} = sep $+        pretty elmConstructorName : map elmTypeRefDoc elmConstructorFields++    -- Generates 'unTYPENAME' function for newtype+    unFunc :: Doc ann+    unFunc =+        if elmTypeIsNewtype+        then line <> elmUnFuncDoc t+        else emptyDoc++    enumFuncs :: Doc ann+    enumFuncs =+        if isEnum t+        then vsep $ map (line <>) [elmEnumShowDoc t, elmEnumReadDoc t, elmEnumUniverse t]+        else emptyDoc++elmUnFuncDoc :: ElmType -> Doc ann+elmUnFuncDoc ElmType{..} = line <> vsep+    [ unName <+> colon <+> typeWithVarsDoc elmTypeName elmTypeVars <+> arrow <+> result+    , unName <+> parens (ctorName <+> "x") <+> equals <+> "x"+    ]+  where+    unName :: Doc ann+    unName = "un" <> pretty elmTypeName++    ctor :: ElmConstructor+    ctor = NE.head elmTypeConstructors++    result :: Doc ann+    result = case elmConstructorFields ctor of+        []      -> "ERROR"+        fld : _ -> elmTypeRefDoc fld++    ctorName :: Doc ann+    ctorName = pretty $ elmConstructorName ctor++elmEnumShowDoc :: forall ann . ElmType -> Doc ann+elmEnumShowDoc t@ElmType{..} =+    line+    -- function type+    <> (showName <+> colon <+> pretty elmTypeName <+> arrow <+> "String")+    <> line+    -- function body+    <> nest 4+        ( vsep $ (showName <+> "x" <+> equals <+> "case x of")+        -- pattern matching+        : map patternMatch (getConstructorNames t)+        )+  where+    showName :: Doc ann+    showName = "show" <> pretty elmTypeName++    patternMatch :: Text -> Doc ann+    patternMatch (pretty -> c) = c <+> arrow <+> dquotes c++elmEnumReadDoc :: ElmType -> Doc ann+elmEnumReadDoc t@ElmType{..} =+    -- function type+    (readName <+> colon <+> "String" <+> arrow <+> "Maybe" <+> pretty elmTypeName)+    <> line+    -- function body+    <> nest 4+        ( vsep $ (readName <+> "x" <+> equals <+> "case x of")+        -- pattern matching+        : map patternMatch (getConstructorNames t)+       ++ ["_" <+> arrow <+> "Nothing"]+        )+  where+    readName :: Doc ann+    readName = "read" <> pretty elmTypeName++    patternMatch :: Text -> Doc ann+    patternMatch (pretty -> c) = dquotes c <+> arrow <+> "Just" <+> c++elmEnumUniverse :: ElmType -> Doc ann+elmEnumUniverse t@ElmType{..} = vsep+    -- function type+    [ universeName <+> colon <+> "List" <+> pretty elmTypeName+    , universeName <+> equals <+> prettyList (getConstructorNames t)+    ]+  where+    universeName :: Doc ann+    universeName = "universe" <> pretty elmTypeName++arrow :: Doc ann+arrow = "->"++----------------------------------------------------------------------------+-- Encode+----------------------------------------------------------------------------++{- | Returns the encoder for the given type.+++TODO+ +-------------------+------------------+-----------------+---------------------++ |    Haskell Type   |     Eml Type     |     Encoder     |       JSON          |+ +===================+==================+=================+=====================++ |   'Int'           |      'Int'       | standard encoder |                    |+ +-------------------+------------------+------------------+--------------------+++-}+prettyShowEncoder :: ElmDefinition -> Text+prettyShowEncoder def = showDoc $ case def of+    DefAlias elmAlias -> aliasEncoderDoc elmAlias+    DefType elmType   -> typeEncoderDoc elmType+    DefPrim _         -> emptyDoc++-- | Encoder for 'ElmType' (which is either enum or the Sum type).+typeEncoderDoc :: ElmType -> Doc ann+typeEncoderDoc t@ElmType{..} =+    -- function defenition: @encodeTypeName : TypeName -> Value@.+       encoderDef elmTypeName elmTypeVars+    <> line+    <> if isEnum t+       -- if this is Enum just using the show instance we wrote.+       then enumEncoder+       else if elmTypeIsNewtype+            -- if this is type with one constructor and one field then it should just call encoder for wrapped type+            then newtypeEncoder+            -- If it sum type then it should look like: @{"tag": "Foo", "contents" : ["string", 1]}@+            else sumEncoder+  where+    enumEncoder :: Doc ann+    enumEncoder = name <+> equals <+> "E.string << show" <> pretty elmTypeName++    newtypeEncoder :: Doc ann+    newtypeEncoder =+        name <+> equals <+> fieldEncoderDoc <+> "<< un" <> pretty elmTypeName+      where+        fieldEncoderDoc :: Doc ann+        fieldEncoderDoc = case elmConstructorFields $ NE.head elmTypeConstructors of+            []    -> "ERROR"+            f : _ -> typeRefEncoder f++    sumEncoder :: Doc ann+    sumEncoder = nest 4+        $ vsep+        $ (name <+> "x" <+> equals <+> "E.object <| case x of")+        : map mkCase (toList elmTypeConstructors)++    -- | Encoder function name+    name :: Doc ann+    name = encoderName elmTypeName++    -- | Create case clouse for each of the sum Constructors.+    mkCase :: ElmConstructor -> Doc ann+    mkCase ElmConstructor{..} =+        conName <+> vars <+> arrow+            <+> brackets (parens (dquotes "tag" <> comma <+> "E.string" <+> dquotes conName) <> contents)+      where+        -- | Constructor name+        conName :: Doc ann+        conName = pretty elmConstructorName++        -- | Creates variables: @x1@ to @xN@, where N is the number of the constructor fields.+        fields :: [Doc ann]+        fields = take (length elmConstructorFields) $+            map (pretty . mkText "x") [1..]++        contents :: Doc ann+        contents = "," <+> parens (dquotes "contents" <> comma <+> "E.list identity" <+> brackets fieldEncs)++        -- | @encoderA x1@+        fieldEncs :: Doc ann+        fieldEncs = concatWith (surround ", ") $+            zipWith (<+>) (map typeRefEncoder elmConstructorFields) fields++        -- | Makes variable like: @x11@ etc.+        mkText :: Text -> Int -> Text+        mkText x i = x <> T.pack (show i)++        vars :: Doc ann+        vars =  concatWith (surround " ") fields+++aliasEncoderDoc :: ElmAlias -> Doc ann+aliasEncoderDoc ElmAlias{..} =+    encoderDef elmAliasName []+    <> line+    <> if elmAliasIsNewtype+       then newtypeEncoder+       else recordEncoder+  where+    newtypeEncoder :: Doc ann+    newtypeEncoder = leftPart <+> fieldEncoderDoc (NE.head elmAliasFields)++    recordEncoder :: Doc ann+    recordEncoder = nest 4+        $ vsep+        $ (leftPart <+> "E.object")+        : fieldsEncode elmAliasFields++    leftPart :: Doc ann+    leftPart = encoderName elmAliasName <+> "x" <+> equals++    fieldsEncode :: NonEmpty ElmRecordField -> [Doc ann]+    fieldsEncode (fstR :| rest) =+        lbracket <+> recordFieldDoc fstR+      : map ((comma <+>) . recordFieldDoc) rest+     ++ [rbracket]++    recordFieldDoc :: ElmRecordField -> Doc ann+    recordFieldDoc field@ElmRecordField{..} = parens $+            dquotes (pretty elmRecordFieldName)+         <> comma+        <+> fieldEncoderDoc field++    fieldEncoderDoc :: ElmRecordField -> Doc ann+    fieldEncoderDoc ElmRecordField{..} =+        typeRefEncoder elmRecordFieldType <+> "x." <> pretty elmRecordFieldName++-- | The definition of the @encodeTYPENAME@ function.+encoderDef+    :: Text  -- ^ Type name+    -> [Text] -- ^ List of type variables+    -> Doc ann+encoderDef typeName vars =+    encoderName typeName <+> colon <+> typeWithVarsDoc typeName vars <+> arrow <+> "Value"++typeWithVarsDoc+    :: Text  -- ^ Type name+    -> [Text] -- ^ List of type variables+    -> Doc ann+typeWithVarsDoc typeName = \case+    []   -> pretty typeName+    vars -> pretty typeName <+> typeVarsDoc vars+  where+    typeVarsDoc :: [Text] -> Doc ann+    typeVarsDoc = concatWith (surround " ") . map pretty++-- | Create the name of the encoder function.+encoderName :: Text -> Doc ann+encoderName typeName = "encode" <> pretty typeName++-- | Converts the reference to the existing type to the corresponding encoder.+typeRefEncoder :: TypeRef -> Doc ann+typeRefEncoder (RefCustom TypeName{..}) = "encode" <> pretty (T.takeWhile (/= ' ') unTypeName)+typeRefEncoder (RefPrim elmPrim) = case elmPrim of+    ElmUnit       -> "(always <| E.list identity [])"+    ElmNever      -> "never"+    ElmBool       -> "E.bool"+    ElmChar       -> parens "E.string << String.fromChar"+    ElmInt        -> "E.int"+    ElmFloat      -> "E.float"+    ElmString     -> "E.string"+    ElmTime       -> "Iso.encode"+    ElmMaybe t    -> parens $ "elmStreetEncodeMaybe" <+> typeRefEncoder t+    ElmResult l r -> parens $ "elmStreetEncodeEither" <+> typeRefEncoder l <+> typeRefEncoder r+    ElmPair a b   -> parens $ "elmStreetEncodePair" <+> typeRefEncoder a <+> typeRefEncoder b+    ElmList l     -> "E.list" <+> typeRefEncoder l++encodeMaybe :: Text+encodeMaybe = T.unlines+    [ "elmStreetEncodeMaybe : (a -> Value) -> Maybe a -> Value"+    , "elmStreetEncodeMaybe enc = Maybe.withDefault E.null << Maybe.map enc"+    ]++encodeEither :: Text+encodeEither = T.unlines+    [ "elmStreetEncodeEither : (a -> Value) -> (b -> Value) -> Result a b -> Value"+    , "elmStreetEncodeEither encA encB res = E.object <| case res of"+    , "    Err a -> [(\"Left\",  encA a)]"+    , "    Ok b  -> [(\"Right\", encB b)]"+    ]++encodePair :: Text+encodePair = T.unlines+    [ "elmStreetEncodePair : (a -> Value) -> (b -> Value) -> (a, b) -> Value"+    , "elmStreetEncodePair encA encB (a, b) = E.list identity [encA a, encB b]"+    ]++----------------------------------------------------------------------------+-- Decode+----------------------------------------------------------------------------++{- |++**Sum Types:**++Haskell type++@+type User+    = Foo+    | Bar String Int+@++Encoded JSON on Haskell side++@+    [ { "tag" : "Foo"+      }+    , { "tag" : "Bar"+      , "contents" : ["asd", 42, "qwerty"]+      }+    ]+@++Elm decoder++@+userDecoder : Decoder User+userDecoder =+    let decide : String -> Decoder User+        decide x = case x of+            "Foo" -> D.succeed Foo+            "Bar" -> D.field "contents" <| D.map2 Bar (D.index 0 D.string) (D.index 1 D.int)+            x -> D.fail <| "There is no constructor for User type:" ++ x+    in D.andThen decide (D.field "tag" D.string)+@++-}+prettyShowDecoder :: ElmDefinition -> Text+prettyShowDecoder def = showDoc $ case def of+    DefAlias elmAlias -> aliasDecoderDoc elmAlias+    DefType elmType   -> typeDecoderDoc elmType+    DefPrim _         -> emptyDoc++aliasDecoderDoc :: ElmAlias -> Doc ann+aliasDecoderDoc ElmAlias{..} =+    decoderDef elmAliasName []+    <> line+    <> if elmAliasIsNewtype+       then newtypeDecoder+       else recordDecoder+  where+    newtypeDecoder :: Doc ann+    newtypeDecoder = name <+> "D.map" <+> aliasName+        <+> typeRefDecoder (elmRecordFieldType $ NE.head elmAliasFields)++    recordDecoder :: Doc ann+    recordDecoder = nest 4+        $ vsep+        $ (name <+> "D.succeed" <+> aliasName)+        : map fieldDecode (toList elmAliasFields)++    name :: Doc ann+    name = decoderName elmAliasName <+> equals++    aliasName :: Doc ann+    aliasName = pretty elmAliasName++    fieldDecode :: ElmRecordField -> Doc ann+    fieldDecode ElmRecordField{..} = case elmRecordFieldType of+        RefPrim ElmUnit -> "|> D.hardcoded ()"+        t -> "|> required"+            <+> dquotes (pretty elmRecordFieldName)+            <+> typeRefDecoder t++typeDecoderDoc :: ElmType -> Doc ann+typeDecoderDoc  t@ElmType{..} =+    -- function defenition: @encodeTypeName : TypeName -> Value@.+       decoderDef elmTypeName elmTypeVars+    <> line+    <> if isEnum t+       -- if this is Enum just using the read instance we wrote.+       then enumDecoder+       else if elmTypeIsNewtype+            -- if it newtype then wrap decoder for the field+            then newtypeDecoder+            -- If it sum type then it should look like: @{"tag": "Foo", "contents" : ["string", 1]}@+            else sumDecoder+  where+    name :: Doc ann+    name = decoderName elmTypeName <+> equals++    typeName :: Doc ann+    typeName = pretty elmTypeName++    enumDecoder :: Doc ann+    enumDecoder = name <+> "elmStreetDecodeEnum read" <> typeName++    newtypeDecoder :: Doc ann+    newtypeDecoder = name <+> "D.map" <+> typeName <+> fieldDecoderDoc+      where+        fieldDecoderDoc :: Doc ann+        fieldDecoderDoc = case elmConstructorFields $ NE.head elmTypeConstructors of+            []    -> "(D.fail \"Unknown field type of the newtype constructor\")"+            f : _ -> typeRefDecoder f++    sumDecoder :: Doc ann+    sumDecoder = nest 4 $ vsep+        [ name+        , nest 4 (vsep $ ("let decide : String -> Decoder" <+> typeName) :+            [ nest 4+                ( vsep $ "decide x = case x of"+                : map cases (toList elmTypeConstructors)+               ++ ["c -> D.fail <|" <+> dquotes (typeName <+> "doesn't have such constructor: ") <+> "++ c"]+                )+            ])+        , "in D.andThen decide (D.field \"tag\" D.string)"+        ]++    cases :: ElmConstructor -> Doc ann+    cases ElmConstructor{..} = dquotes cName <+> arrow <+>+        case length elmConstructorFields of+            0 -> "D.succeed" <+> cName+            n -> "D.field \"contents\" <| D.map" <> mapNum n <+> cName <+> createIndexes++      where+        cName :: Doc ann+        cName = pretty elmConstructorName++        -- Use function map, map2, map3 etc.+        mapNum :: Int -> Doc ann+        mapNum 1 = emptyDoc+        mapNum i = pretty i++        createIndexes :: Doc ann+        createIndexes = concatWith (surround " ") $ zipWith oneField [0..] elmConstructorFields++        -- create @(D.index 0 D.string)@ etc.+        oneField :: Int -> TypeRef -> Doc ann+        oneField i typeRef = parens $ "D.index" <+> pretty i <+> typeRefDecoder typeRef++-- | Converts the reference to the existing type to the corresponding decoder.+typeRefDecoder :: TypeRef -> Doc ann+typeRefDecoder (RefCustom TypeName{..}) = "decode" <> pretty (T.takeWhile (/= ' ') unTypeName)+typeRefDecoder (RefPrim elmPrim) = case elmPrim of+    ElmUnit       -> "(D.hardcoded ())"+    ElmNever      -> "(D.fail \"Never is not possible\")"+    ElmBool       -> "D.bool"+    ElmChar       -> "elmStreetDecodeChar"+    ElmInt        -> "D.int"+    ElmFloat      -> "D.float"+    ElmString     -> "D.string"+    ElmTime       -> "Iso.decoder"+    ElmMaybe t    -> parens $ "nullable" <+> typeRefDecoder t+    ElmResult l r -> parens $ "elmStreetDecodeEither" <+> typeRefDecoder l <+> typeRefDecoder r+    ElmPair a b   -> parens $ "elmStreetDecodePair" <+> typeRefDecoder a <+> typeRefDecoder b+    ElmList l     -> parens $ "D.list" <+> typeRefDecoder l++-- | The definition of the @encodeTYPENAME@ function.+decoderDef+    :: Text  -- ^ Type name+    -> [Text] -- ^ List of type variables+    -> Doc ann+decoderDef typeName vars =+    decoderName typeName <+> colon <+> "Decoder" <+> wrapParens (typeWithVarsDoc typeName vars)++-- | Create the name of the decoder function.+decoderName :: Text -> Doc ann+decoderName typeName = "decode" <> pretty typeName++decodeEnum :: Text+decodeEnum = T.unlines+    [ "decodeStr : (String -> Maybe a) -> String -> Decoder a"+    , "decodeStr readX x = case readX x of"+    , "    Just a  -> D.succeed a"+    , "    Nothing -> D.fail \"Constructor not matched\""+    , ""+    , "elmStreetDecodeEnum : (String -> Maybe a) -> Decoder a"+    , "elmStreetDecodeEnum r = D.andThen (decodeStr r) D.string"+    ]++decodeChar :: Text+decodeChar = T.unlines+    [ "elmStreetDecodeChar : Decoder Char"+    , "elmStreetDecodeChar = D.andThen (decodeStr (Maybe.map Tuple.first << String.uncons)) D.string"+    ]++decodeEither :: Text+decodeEither = T.unlines+    [ "elmStreetDecodeEither : Decoder a -> Decoder b -> Decoder (Result a b)"+    , "elmStreetDecodeEither decA decB = D.oneOf "+    , "    [ D.field \"Left\"  (D.map Err decA)"+    , "    , D.field \"Right\" (D.map Ok decB)"+    , "    ]"+    ]++decodePair :: Text+decodePair = T.unlines+    [ "elmStreetDecodePair : Decoder a -> Decoder b -> Decoder (a, b)"+    , "elmStreetDecodePair decA decB = D.map2 Tuple.pair (D.index 0 decA) (D.index 1 decB)"+    ]++{-+putStrLn $ T.unpack $ prettyShowDefinition $ DefAlias $ ElmAlias "User" $ (ElmRecordField (TypeName "String") "userHeh") :| [ElmRecordField (TypeName "Int") "userMeh"]++ENUM:+putStrLn $ T.unpack $ prettyShowDefinition $ DefType $ ElmType "Status" [] $ (ElmConstructor "Approved" []) :| [ElmConstructor  "Yoyoyo" [], ElmConstructor "Wow" []]+putStrLn $ T.unpack $ prettyShowEncoder $ DefType $ ElmType "Status" [] $ (ElmConstructor "Approved" []) :| [ElmConstructor  "Yoyoyo" [], ElmConstructor "Wow" []]++putStrLn $ T.unpack $ prettyShowDefinition $ DefType $ ElmType "Status" [] $ (ElmConstructor "Approved" [TypeName "String", TypeName "Int"]) :| [ElmConstructor  "Yoyoyo" [], ElmConstructor "Wow" [TypeName "a"]]++putStrLn $ T.unpack $ prettyShowDefinition $ DefType $ ElmType "Status" ["a"] $ (ElmConstructor "Approved" [TypeName "String", TypeName "Int"]) :| [ElmConstructor  "Yoyoyo" [], ElmConstructor "Wow" [TypeName "a"]]+-}

@@ -0,0 +1,4 @@+module Main (main) where++main :: IO ()+main = putStrLn ("Test suite not yet implemented" :: String)

@@ -0,0 +1,166 @@+{-# LANGUAGE CPP                #-}+{-# LANGUAGE DataKinds          #-}+{-# LANGUAGE DeriveAnyClass     #-}+#if ( __GLASGOW_HASKELL__ >= 806 )+{-# LANGUAGE DerivingVia        #-}+#endif+{-# LANGUAGE DerivingStrategies #-}++{- | Haskell types used for testing `elm-street` generated Elm types.+-}++module Types+       ( Types+       , OneType (..)+       , defaultOneType++         -- * All test types+       , Prims (..)+       , Id (..)+       , Age (..)+       , RequestStatus (..)+       , User (..)+       , Guest (..)+       , UserRequest (..)+       ) where++import Data.Aeson (FromJSON (..), ToJSON (..))+import Data.Text (Text)+import Data.Time.Calendar (fromGregorian)+import Data.Time.Clock (UTCTime (..))+import Data.Word (Word32)+import Elm (Elm (..), ElmStreet (..), elmNewtype, elmStreetParseJson, elmStreetToJson)+import GHC.Generics (Generic)+++data Prims = Prims+    { primsUnit   :: ()+    , primsBool   :: Bool+    , primsChar   :: Char+    , primsInt    :: Int+    , primsFloat  :: Double+    , primsString :: String+    , primsTime   :: UTCTime+    , primsMaybe  :: Maybe Word+    , primsResult :: Either Int String+    , primsPair   :: (Char, Bool)+    , primsList   :: [Int]+    } deriving (Generic, Eq, Show)+#if ( __GLASGOW_HASKELL__ >= 806 )+      deriving (Elm, ToJSON, FromJSON) via ElmStreet Prims+#else+      deriving anyclass Elm++instance ToJSON   Prims where toJSON = elmStreetToJson+instance FromJSON Prims where parseJSON = elmStreetParseJson+#endif++newtype Id a = Id+    { unId :: Text+    } deriving (Show, Eq)+      deriving newtype (FromJSON, ToJSON)++instance Elm (Id a) where+    toElmDefinition _ = elmNewtype @Text "Id" "unId"++newtype Age = Age+    { unAge :: Int+    } deriving (Generic, Eq, Show)+      deriving anyclass (Elm)+      deriving newtype (FromJSON, ToJSON)++data RequestStatus+    = Approved+    | Rejected+    | Reviewing+    deriving (Generic, Eq, Show)+    deriving anyclass (Elm, FromJSON, ToJSON)++data User = User+    { userId     :: Id User+    , userName   :: Text+    , userAge    :: Age+    , userStatus :: RequestStatus+    } deriving (Generic, Eq, Show)+      deriving anyclass (Elm)++instance ToJSON   User where toJSON = elmStreetToJson+instance FromJSON User where parseJSON = elmStreetParseJson++data Guest+    = Regular Text Int+    | Visitor Text+    | Blocked+    deriving (Generic, Eq, Show)+    deriving anyclass (Elm, FromJSON, ToJSON)++data UserRequest = UserRequest+    { userRequestIds     :: [Id User]+    , userRequestLimit   :: Word32+    , userRequestExample :: Maybe (Either User Guest)+    } deriving (Generic, Eq, Show)+      deriving anyclass (Elm)++instance ToJSON   UserRequest where toJSON = elmStreetToJson+instance FromJSON UserRequest where parseJSON = elmStreetParseJson++-- | All test types together in one type to play with.+data OneType = OneType+    { oneTypePrims         :: Prims+    , oneTypeId            :: Id OneType+    , oneTypeAge           :: Age+    , oneTypeRequestStatus :: RequestStatus+    , oneTypeUser          :: User+    , oneTypeGuest         :: Guest+    , oneTypeUserRequest   :: UserRequest+    } deriving (Generic, Eq, Show)+      deriving anyclass (Elm)++instance ToJSON   OneType where toJSON = elmStreetToJson+instance FromJSON OneType where parseJSON = elmStreetParseJson++-- | Type level list of all test types.+type Types =+   '[ Prims+    , Id ()+    , Age+    , RequestStatus+    , User+    , Guest+    , UserRequest+    , OneType+    ]+++defaultOneType :: OneType+defaultOneType = OneType+    { oneTypePrims = defaultPrims+    , oneTypeId = Id "myId"+    , oneTypeAge = Age 18+    , oneTypeRequestStatus = Reviewing+    , oneTypeUser = User (Id "1") "not-me" (Age 100) Approved+    , oneTypeGuest = Regular "nice" 7+    , oneTypeUserRequest = defaultUserRequest+    }+  where+    defaultPrims :: Prims+    defaultPrims = Prims+        { primsUnit   = ()+        , primsBool   = True+        , primsChar   = 'a'+        , primsInt    = 42+        , primsFloat  = 36.6+        , primsString = "heh"+        , primsTime   = UTCTime (fromGregorian 2019 2 22) 0+        , primsMaybe  = Just 12+        , primsResult = Left 666+        , primsPair   = ('o', False)+        , primsList   = [1..5]+        }++    defaultUserRequest :: UserRequest+    defaultUserRequest = UserRequest+        { userRequestIds     = [Id "1", Id "2"]+        , userRequestLimit   = 123+        , userRequestExample = Just (Right Blocked)+        }