elm-export (empty) → 0.3.0.0
raw patch · 12 files changed
+816/−0 lines, 12 filesdep +QuickCheckdep +basedep +bytestringsetup-changed
Dependencies added: QuickCheck, base, bytestring, containers, directory, elm-export, hspec, hspec-core, mtl, quickcheck-instances, text, time
Files
- LICENSE.txt +198/−0
- Setup.hs +2/−0
- elm-export.cabal +59/−0
- src/Elm.hs +8/−0
- src/Elm/Common.hs +21/−0
- src/Elm/Decoder.hs +68/−0
- src/Elm/Encoder.hs +61/−0
- src/Elm/File.hs +38/−0
- src/Elm/Record.hs +73/−0
- src/Elm/Type.hs +119/−0
- test/ExportSpec.hs +168/−0
- test/Spec.hs +1/−0
+ LICENSE.txt view
@@ -0,0 +1,198 @@+Eclipse Public License - v 1.0++THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC+LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM+CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT.++1. DEFINITIONS++"Contribution" means:++a) in the case of the initial Contributor, the initial code and documentation+ distributed under this Agreement, and+b) in the case of each subsequent Contributor:+ i) changes to the Program, and+ ii) additions to the Program;++ where such changes and/or additions to the Program originate from and are+ distributed by that particular Contributor. A Contribution 'originates' from+ a Contributor if it was added to the Program by such Contributor itself or+ anyone acting on such Contributor's behalf. Contributions do not include+ additions to the Program which: (i) are separate modules of software+ distributed in conjunction with the Program under their own license+ agreement, and (ii) are not derivative works of the Program.++"Contributor" means any person or entity that distributes the Program.++"Licensed Patents" mean patent claims licensable by a Contributor which are+necessarily infringed by the use or sale of its Contribution alone or when+combined with the Program.++"Program" means the Contributions distributed in accordance with this Agreement.++"Recipient" means anyone who receives the Program under this Agreement,+including all Contributors.++2. GRANT OF RIGHTS+ a) Subject to the terms of this Agreement, each Contributor hereby grants+ Recipient a non-exclusive, worldwide, royalty-free copyright license to+ reproduce, prepare derivative works of, publicly display, publicly perform,+ distribute and sublicense the Contribution of such Contributor, if any, and+ such derivative works, in source code and object code form.+ b) Subject to the terms of this Agreement, each Contributor hereby grants+ Recipient a non-exclusive, worldwide, royalty-free patent license under+ Licensed Patents to make, use, sell, offer to sell, import and otherwise+ transfer the Contribution of such Contributor, if any, in source code and+ object code form. This patent license shall apply to the combination of the+ Contribution and the Program if, at the time the Contribution is added by+ the Contributor, such addition of the Contribution causes such combination+ to be covered by the Licensed Patents. The patent license shall not apply+ to any other combinations which include the Contribution. No hardware per+ se is licensed hereunder.+ c) Recipient understands that although each Contributor grants the licenses to+ its Contributions set forth herein, no assurances are provided by any+ Contributor that the Program does not infringe the patent or other+ intellectual property rights of any other entity. Each Contributor+ disclaims any liability to Recipient for claims brought by any other entity+ based on infringement of intellectual property rights or otherwise. As a+ condition to exercising the rights and licenses granted hereunder, each+ Recipient hereby assumes sole responsibility to secure any other+ intellectual property rights needed, if any. For example, if a third party+ patent license is required to allow Recipient to distribute the Program, it+ is Recipient's responsibility to acquire that license before distributing+ the Program.+ d) Each Contributor represents that to its knowledge it has sufficient+ copyright rights in its Contribution, if any, to grant the copyright+ license set forth in this Agreement.++3. REQUIREMENTS++A Contributor may choose to distribute the Program in object code form under its+own license agreement, provided that:++ a) it complies with the terms and conditions of this Agreement; and+ b) its license agreement:+ i) effectively disclaims on behalf of all Contributors all warranties and+ conditions, express and implied, including warranties or conditions of+ title and non-infringement, and implied warranties or conditions of+ merchantability and fitness for a particular purpose;+ ii) effectively excludes on behalf of all Contributors all liability for+ damages, including direct, indirect, special, incidental and+ consequential damages, such as lost profits;+ iii) states that any provisions which differ from this Agreement are offered+ by that Contributor alone and not by any other party; and+ iv) states that source code for the Program is available from such+ Contributor, and informs licensees how to obtain it in a reasonable+ manner on or through a medium customarily used for software exchange.++When the Program is made available in source code form:++ a) it must be made available under this Agreement; and+ b) a copy of this Agreement must be included with each copy of the Program.+ Contributors may not remove or alter any copyright notices contained within+ the Program.++Each Contributor must identify itself as the originator of its Contribution, if+any, in a manner that reasonably allows subsequent Recipients to identify the+originator of the Contribution.++4. COMMERCIAL DISTRIBUTION++Commercial distributors of software may accept certain responsibilities with+respect to end users, business partners and the like. While this license is+intended to facilitate the commercial use of the Program, the Contributor who+includes the Program in a commercial product offering should do so in a manner+which does not create potential liability for other Contributors. Therefore, if+a Contributor includes the Program in a commercial product offering, such+Contributor ("Commercial Contributor") hereby agrees to defend and indemnify+every other Contributor ("Indemnified Contributor") against any losses, damages+and costs (collectively "Losses") arising from claims, lawsuits and other legal+actions brought by a third party against the Indemnified Contributor to the+extent caused by the acts or omissions of such Commercial Contributor in+connection with its distribution of the Program in a commercial product+offering. The obligations in this section do not apply to any claims or Losses+relating to any actual or alleged intellectual property infringement. In order+to qualify, an Indemnified Contributor must: a) promptly notify the Commercial+Contributor in writing of such claim, and b) allow the Commercial Contributor to+control, and cooperate with the Commercial Contributor in, the defense and any+related settlement negotiations. The Indemnified Contributor may participate in+any such claim at its own expense.++For example, a Contributor might include the Program in a commercial product+offering, Product X. That Contributor is then a Commercial Contributor. If that+Commercial Contributor then makes performance claims, or offers warranties+related to Product X, those performance claims and warranties are such+Commercial Contributor's responsibility alone. Under this section, the+Commercial Contributor would have to defend claims against the other+Contributors related to those performance claims and warranties, and if a court+requires any other Contributor to pay any damages as a result, the Commercial+Contributor must pay those damages.++5. NO WARRANTY++EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON AN+"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR+IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF TITLE,+NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Each+Recipient is solely responsible for determining the appropriateness of using and+distributing the Program and assumes all risks associated with its exercise of+rights under this Agreement , including but not limited to the risks and costs+of program errors, compliance with applicable laws, damage to or loss of data,+programs or equipment, and unavailability or interruption of operations.++6. DISCLAIMER OF LIABILITY++EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY+CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION LOST+PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE EXERCISE OF ANY RIGHTS+GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.++7. GENERAL++If any provision of this Agreement is invalid or unenforceable under applicable+law, it shall not affect the validity or enforceability of the remainder of the+terms of this Agreement, and without further action by the parties hereto, such+provision shall be reformed to the minimum extent necessary to make such+provision valid and enforceable.++If Recipient institutes patent litigation against any entity (including a+cross-claim or counterclaim in a lawsuit) alleging that the Program itself+(excluding combinations of the Program with other software or hardware)+infringes such Recipient's patent(s), then such Recipient's rights granted under+Section 2(b) shall terminate as of the date such litigation is filed.++All Recipient's rights under this Agreement shall terminate if it fails to+comply with any of the material terms or conditions of this Agreement and does+not cure such failure in a reasonable period of time after becoming aware of+such noncompliance. If all Recipient's rights under this Agreement terminate,+Recipient agrees to cease use and distribution of the Program as soon as+reasonably practicable. However, Recipient's obligations under this Agreement+and any licenses granted by Recipient relating to the Program shall continue and+survive.++Everyone is permitted to copy and distribute copies of this Agreement, but in+order to avoid inconsistency the Agreement is copyrighted and may only be+modified in the following manner. The Agreement Steward reserves the right to+publish new versions (including revisions) of this Agreement from time to time.+No one other than the Agreement Steward has the right to modify this Agreement.+The Eclipse Foundation is the initial Agreement Steward. The Eclipse Foundation+may assign the responsibility to serve as the Agreement Steward to a suitable+separate entity. Each new version of the Agreement will be given a+distinguishing version number. The Program (including Contributions) may always+be distributed subject to the version of the Agreement under which it was+received. In addition, after a new version of the Agreement is published,+Contributor may elect to distribute the Program (including its Contributions)+under the new version. Except as expressly stated in Sections 2(a) and 2(b)+above, Recipient receives no rights or licenses to the intellectual property of+any Contributor under this Agreement, whether expressly, by implication,+estoppel or otherwise. All rights in the Program not expressly granted under+this Agreement are reserved.++This Agreement is governed by the laws of the State of New York and the+intellectual property laws of the United States of America. No party to this+Agreement will bring a legal action under this Agreement more than one year+after the cause of action arose. Each party waives its rights to a jury trial in+any resulting litigation.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ elm-export.cabal view
@@ -0,0 +1,59 @@+name: elm-export+version: 0.3.0.0+cabal-version: >=1.10+build-type: Simple+license: OtherLicense+license-file: LICENSE.txt+copyright: 2015 Kris Jenkins+maintainer: kris.jenkins@clearercode.com+homepage: http://github.com/krisajenkins/elm-export+synopsis: A library to generate Elm types from Haskell source.+description:+ Please see README.md+category: Web+author: Kris Jenkins++source-repository head+ type: git+ location: https://github.com/krisajenkins/elm-export++library+ exposed-modules:+ Elm+ build-depends:+ base >=4.7 && <5,+ bytestring >=0.10.6.0 && <0.11,+ containers >=0.5.6.2 && <0.6,+ directory >=1.2.2.0 && <1.3,+ mtl >=2.2.1 && <2.3,+ text >=1.2.2.0 && <1.3,+ time >=1.5.0.1 && <1.6+ default-language: Haskell2010+ hs-source-dirs: src+ other-modules:+ Elm.Type+ Elm.Common+ Elm.Decoder+ Elm.Encoder+ Elm.File+ Elm.Record++test-suite elm-export-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ build-depends:+ QuickCheck >=2.8.1 && <2.9,+ base >=4.8.2.0 && <4.9,+ bytestring >=0.10.6.0 && <0.11,+ containers >=0.5.6.2 && <0.6,+ elm-export >=0.3.0.0 && <0.4,+ hspec >=2.2.2 && <2.3,+ hspec-core >=2.2.2 && <2.3,+ quickcheck-instances >=0.3.12 && <0.4,+ text >=1.2.2.0 && <1.3,+ time >=1.5.0.1 && <1.6+ default-language: Haskell2010+ hs-source-dirs: test+ other-modules:+ ExportSpec+ ghc-options: -threaded -rtsopts -with-rtsopts=-N
+ src/Elm.hs view
@@ -0,0 +1,8 @@+module Elm (module X) where++import Elm.Common as X (Options (..), defaultOptions)+import Elm.Decoder as X+import Elm.Encoder as X+import Elm.File as X+import Elm.Record as X+import Elm.Type as X
+ src/Elm/Common.hs view
@@ -0,0 +1,21 @@+module Elm.Common where++import Elm.Type++isTopLevel :: ElmTypeExpr -> Bool+isTopLevel (Primitive _) = True+isTopLevel (DataType _ _) = True+isTopLevel (Product (Primitive "List") (Primitive "Char")) = True+isTopLevel _ = False++-- Put parentheses around the string if the Elm type requires it (i.e. it's not a+-- Primitive Elm type nor a named DataType).+parenthesize :: ElmTypeExpr -> String -> String+parenthesize t s =+ if isTopLevel t then s else "(" ++ s ++ ")"++data Options =+ Options {fieldLabelModifier :: String -> String}++defaultOptions :: Options+defaultOptions = Options {fieldLabelModifier = id}
+ src/Elm/Decoder.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeOperators #-}++module Elm.Decoder (toElmDecoderSource, toElmDecoderSourceWith)+ where++import Control.Monad.Reader+import Elm.Common+import Elm.Type+import Text.Printf++render :: ElmTypeExpr -> Reader Options String++render (TopLevel (DataType d t)) =+ printf "%s : Json.Decode.Decoder %s\n%s =\n%s" fnName d fnName <$> render t+ where fnName = "decode" ++ d++render (DataType d _) = return $ "decode" ++ d++render (Record n t) = printf " Json.Decode.succeed %s\n%s" n <$> render t++render (Product (Primitive "List") (Primitive "Char")) = render (Primitive "String")++render (Product (Primitive "List") t) = printf "Json.Decode.list %s" <$> render t++render (Product (Primitive "Maybe") t) = printf "Json.Decode.maybe %s" <$> render t++render (Product x y) =+ do bodyX <- render x+ bodyY <- render y+ return $ printf "%s\n%s" bodyX bodyY++render (Selector n t) =+ do fieldModifier <- asks fieldLabelModifier+ printf " |: (\"%s\" := %s)" (fieldModifier n) <$> render t++render (Tuple2 x y) =+ do bodyX <- render x+ bodyY <- render y+ return $ printf "Json.Decode.tuple2 (,) %s %s" bodyX bodyY++render (Dict x y) =+ printf "Json.Decode.map Dict.fromList (Json.Decode.list (%s))" <$> render (Tuple2 x y)++render (Primitive "String") = return "Json.Decode.string"++render (Primitive "Int") = return "Json.Decode.int"++render (Primitive "Double") = return "Json.Decode.float"++render (Primitive "Float") = return "Json.Decode.float"++render (Primitive "Date") = return "Json.Decode.Extra.date"++render (Primitive "Bool") = return "Json.Decode.bool"++render (Field t) = render t++render x = return $ printf "<%s>" (show x)++toElmDecoderSourceWith :: ElmType a => Options -> a -> String+toElmDecoderSourceWith options x =+ runReader (render . TopLevel $ toElmType x) options++toElmDecoderSource :: ElmType a => a -> String+toElmDecoderSource = toElmDecoderSourceWith defaultOptions
+ src/Elm/Encoder.hs view
@@ -0,0 +1,61 @@+module Elm.Encoder (toElmEncoderSource, toElmEncoderSourceWith)+ where++import Control.Monad.Reader+import Elm.Common+import Elm.Type+import Text.Printf++render :: ElmTypeExpr -> Reader Options String++render (TopLevel (DataType d t)) =+ printf "%s : %s -> Json.Encode.Value\n%s x =%s" fnName d fnName <$> render t+ where fnName = "encode" ++ d++render (DataType d _) = return $ "encode" ++ d++render (Record _ t) =+ printf "\n Json.Encode.object\n [ %s\n ]" <$> render t++render (Product (Primitive "List") (Primitive "Char")) =+ render (Primitive "String")++render (Product (Primitive "List") t) =+ printf "(Json.Encode.list << List.map %s)" <$> render t++render (Product (Primitive "Maybe") t) =+ printf "(Maybe.withDefault Json.Encode.null << Maybe.map %s)" <$> render t++render (Tuple2 x y) =+ do bodyX <- render x+ bodyY <- render y+ return $ printf "Exts.Json.Encode.tuple2 %s %s" bodyX bodyY++render (Dict x y) =+ do bodyX <- render x+ bodyY <- render y+ return $ printf "Exts.Json.Encode.dict %s %s" bodyX bodyY++render (Product x y) =+ do bodyX <- render x+ bodyY <- render y+ return $ printf "%s\n , %s" bodyX bodyY++render (Selector n t) =+ do fieldModifier <- asks fieldLabelModifier+ typeBody <- render t+ return $ printf "( \"%s\", %s x.%s )" (fieldModifier n) typeBody n++render (Primitive "String") = return "Json.Encode.string"+render (Primitive "Int") = return "Json.Encode.int"+render (Primitive "Double") = return "Json.Encode.float"+render (Primitive "Float") = return "Json.Encode.float"+render (Primitive "Date") = return "(Json.Encode.string << Exts.Date.toISOString)"+render (Primitive "Bool") = return "Json.Encode.bool"+render (Field t) = render t++toElmEncoderSourceWith :: ElmType a => Options -> a -> String+toElmEncoderSourceWith options x = runReader (render . TopLevel $ toElmType x) options++toElmEncoderSource :: ElmType a => a -> String+toElmEncoderSource = toElmEncoderSourceWith defaultOptions
+ src/Elm/File.hs view
@@ -0,0 +1,38 @@+module Elm.File (Spec(..),specsToDir) where++import Data.List+import System.Directory+import Text.Printf++pathString :: [String] -> String+pathString = intercalate "/"++data Spec =+ Spec {namespace :: [String]+ ,declarations :: [String]}++pathForSpec :: FilePath -> Spec -> [String]+pathForSpec rootDir spec = rootDir : namespace spec++ensureDirectory :: FilePath -> Spec -> IO ()+ensureDirectory rootDir spec =+ let dir = pathString . init $ pathForSpec rootDir spec+ in createDirectoryIfMissing True dir++specToFile :: FilePath -> Spec -> IO ()+specToFile rootDir spec =+ let path = pathForSpec rootDir spec+ file = pathString path ++ ".elm"+ namespaceString =+ intercalate "."+ (namespace spec)+ body =+ intercalate+ "\n\n"+ (printf "module %s where" namespaceString : declarations spec)+ in do printf "Writing: %s\n" file+ writeFile file body++specsToDir :: [Spec] -> FilePath -> IO ()+specsToDir specs rootDir = mapM_ processSpec specs+ where processSpec = ensureDirectory rootDir >> specToFile rootDir
+ src/Elm/Record.hs view
@@ -0,0 +1,73 @@+module Elm.Record (toElmTypeSource,toElmTypeSourceWith) where++import Control.Monad.Reader+import Elm.Common+import Elm.Type+import Text.Printf++render :: ElmTypeExpr -> Reader Options String++render (TopLevel (DataType dataTypeName record@(Record _ _))) =+ printf "type alias %s =\n { %s\n }" dataTypeName <$> render record++render (TopLevel (DataType d s@(Sum _ _))) =+ printf "type %s\n = %s" d <$> render s++render (DataType d _) = return d+render (Primitive s) = return s++render (Sum x y) =+ do bodyX <- render x+ bodyY <- render y+ return $ printf "%s\n | %s" bodyX bodyY++render (Field t) = render t++render (Selector s t) = do fieldModifier <- asks fieldLabelModifier+ printf "%s : %s" (fieldModifier s) <$> render t++render (Constructor c Unit) = pure c++render (Constructor c t) = printf "%s %s" c <$> render t++render (Tuple2 x y) =+ do bodyX <- render x+ bodyY <- render y+ return $ printf "( %s, %s )" bodyX bodyY++render (Dict x y) =+ do bodyX <- render x+ bodyY <- render y+ return $ printf "Dict %s %s" bodyX bodyY++render (Product (Primitive "List") (Primitive "Char")) = return "String"++render (Product (Primitive "List") p@(Product _ _)) =+ printf "List (%s)" <$> render p++render (Product (Primitive "List") t) = printf "List %s" <$> render t++render (Product (Primitive "Dict") (Product k v)) =+ do keyBody <- render k+ valueBody <- render v+ return $ printf "Dict %s %s" keyBody valueBody++render (Product x y) =+ do bodyX <- render x+ bodyY <- render y+ return $ printf ("%s " ++ parenthesize y "%s") bodyX bodyY++render (Record n (Product x y)) =+ do bodyX <- render (Record n x)+ bodyY <- render (Record n y)+ return $ printf "%s\n , %s" bodyX bodyY++render (Record _ s@(Selector _ _)) = render s++render Unit = return ""++toElmTypeSourceWith :: ElmType a => Options -> a -> String+toElmTypeSourceWith options x = runReader (render . TopLevel $ toElmType x) options++toElmTypeSource :: ElmType a => a -> String+toElmTypeSource = toElmTypeSourceWith defaultOptions
+ src/Elm/Type.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}+module Elm.Type where++import Data.Map+import Data.Proxy+import Data.Text+import Data.Time+import GHC.Generics+import Prelude++-- TODO Without doubt, this definition can be tightened up so that+-- there are fewer (or hopefully zero) representable illegal states.+data ElmTypeExpr where+ TopLevel :: ElmTypeExpr -> ElmTypeExpr+ DataType :: String -> ElmTypeExpr -> ElmTypeExpr+ Record :: String -> ElmTypeExpr -> ElmTypeExpr+ Constructor :: String -> ElmTypeExpr -> ElmTypeExpr+ Selector :: String -> ElmTypeExpr -> ElmTypeExpr+ Field :: ElmTypeExpr -> ElmTypeExpr+ Sum :: ElmTypeExpr -> ElmTypeExpr -> ElmTypeExpr+ Dict :: ElmTypeExpr -> ElmTypeExpr -> ElmTypeExpr+ Tuple2 :: ElmTypeExpr -> ElmTypeExpr -> ElmTypeExpr+ Product :: ElmTypeExpr -> ElmTypeExpr -> ElmTypeExpr+ Unit :: ElmTypeExpr+ Primitive :: String -> ElmTypeExpr+ deriving (Eq, Show)++class ElmType a where+ toElmType :: a -> ElmTypeExpr+ default toElmType :: (Generic a,GenericElmType (Rep a)) => a -> ElmTypeExpr+ toElmType = genericToElmType . from++instance ElmType Bool where+ toElmType _ = Primitive "Bool"++instance ElmType Char where+ toElmType _ = Primitive "Char"++instance ElmType Text where+ toElmType _ = Primitive "String"++instance ElmType Float where+ toElmType _ = Primitive "Float"++instance ElmType UTCTime where+ toElmType _ = Primitive "Date"++instance ElmType Day where+ toElmType _ = Primitive "Date"++instance ElmType Double where+ toElmType _ = Primitive "Float"++instance ElmType Int where+ toElmType _ = Primitive "Int"++instance ElmType Integer where+ toElmType _ = Primitive "Int"++instance (ElmType a,ElmType b) => ElmType (a,b) where+ toElmType _ =+ Tuple2 (toElmType (Proxy :: Proxy a))+ (toElmType (Proxy :: Proxy b))++instance ElmType a => ElmType [a] where+ toElmType _ = Product (Primitive "List") (toElmType (Proxy :: Proxy a))++instance ElmType a => ElmType (Maybe a) where+ toElmType _ = Product (Primitive "Maybe") (toElmType (Proxy :: Proxy a))++instance (ElmType k,ElmType v) => ElmType (Map k v) where+ toElmType _ =+ Dict (toElmType (Proxy :: Proxy k))+ (toElmType (Proxy :: Proxy v))++instance ElmType a => ElmType (Proxy a) where+ toElmType _ = toElmType (undefined :: a)++class GenericElmType f where+ genericToElmType :: f a -> ElmTypeExpr++instance (GenericElmType f,Datatype d) => GenericElmType (D1 d f) where+ genericToElmType d@(M1 x) =+ DataType (datatypeName d)+ (genericToElmType x)++instance (Constructor c,GenericElmType f) => GenericElmType (C1 c f) where+ genericToElmType c@(M1 x) =+ if conIsRecord c+ then Record name body+ else Constructor name body+ where name = conName c+ body = genericToElmType x++instance (Selector c,GenericElmType f) => GenericElmType (S1 c f) where+ genericToElmType s@(M1 x) =+ Selector (selName s)+ (genericToElmType x)++instance GenericElmType U1 where+ genericToElmType _ = Unit++instance (ElmType c) => GenericElmType (K1 R c) where+ genericToElmType (K1 x) = Field (toElmType x)++instance (GenericElmType f,GenericElmType g) => GenericElmType (f :+: g) where+ genericToElmType _ = Sum+ (genericToElmType (undefined :: f p))+ (genericToElmType (undefined :: g p))++instance (GenericElmType f,GenericElmType g) => GenericElmType (f :*: g) where+ genericToElmType _ =+ Product (genericToElmType (undefined :: f p))+ (genericToElmType (undefined :: g p))
+ test/ExportSpec.hs view
@@ -0,0 +1,168 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++module ExportSpec where++-- import Data.Aeson+-- import Data.ByteString hiding (readFile)+-- import qualified Data.ByteString.Lazy as LBS+import Data.Char+import Data.Map+import Data.Proxy+import Data.Text+import Data.Time+import Elm+import GHC.Generics+import Test.Hspec hiding (Spec)+import Test.Hspec as Hspec+import Text.Printf++data Post =+ Post {id :: Int+ ,name :: String+ ,age :: Maybe Double+ ,comments :: [Comment]+ ,promoted :: Maybe Comment+ ,author :: Maybe String}+ deriving (Generic,ElmType)++data Comment =+ Comment {postId :: Int+ ,text :: Text+ ,mainCategories :: (String,String)+ ,published :: Bool+ ,created :: UTCTime+ ,tags :: Map String Int}+ deriving (Generic,ElmType)++data Position+ = Beginning+ | Middle+ | End+ deriving (Generic,ElmType)++spec :: Hspec.Spec+spec =+ do toElmTypeSpec+ toElmDecoderSpec+ toElmEncoderSpec++toElmTypeSpec :: Hspec.Spec+toElmTypeSpec =+ describe "Convert to Elm types." $+ do it "toElmTypeSource Post" $+ shouldMatchTypeSource defaultOptions+ (Proxy :: Proxy Post)+ "test/PostType.elm"+ it "toElmTypeSource Comment" $+ shouldMatchTypeSource defaultOptions+ (Proxy :: Proxy Comment)+ "test/CommentType.elm"+ it "toElmTypeSource Position" $+ shouldMatchTypeSource defaultOptions+ (Proxy :: Proxy Position)+ "test/PositionType.elm"+ it "toElmTypeSourceWithOptions Post" $+ shouldMatchTypeSource+ (defaultOptions {fieldLabelModifier = withPrefix "post"})+ (Proxy :: Proxy Post)+ "test/PostTypeWithOptions.elm"+ it "toElmTypeSourceWithOptions Comment" $+ shouldMatchTypeSource+ (defaultOptions {fieldLabelModifier = withPrefix "comment"})+ (Proxy :: Proxy Comment)+ "test/CommentTypeWithOptions.elm"++toElmDecoderSpec :: Hspec.Spec+toElmDecoderSpec =+ describe "Convert to Elm decoders." $+ do it "toElmDecoderSource Post" $+ shouldMatchDecoderSource defaultOptions+ (Proxy :: Proxy Post)+ "test/PostDecoder.elm"+ it "toElmDecoderSource Comment" $+ shouldMatchDecoderSource defaultOptions+ (Proxy :: Proxy Comment)+ "test/CommentDecoder.elm"+ it "toElmDecoderSourceWithOptions Post" $+ shouldMatchDecoderSource+ (defaultOptions {fieldLabelModifier = withPrefix "post"})+ (Proxy :: Proxy Post)+ "test/PostDecoderWithOptions.elm"+ it "toElmDecoderSourceWithOptions Comment" $+ shouldMatchDecoderSource+ (defaultOptions {fieldLabelModifier = withPrefix "comment"})+ (Proxy :: Proxy Comment)+ "test/CommentDecoderWithOptions.elm"+ it "toElmDecoderSourceWithOptions Position" $+ shouldMatchDecoderSource+ (defaultOptions {fieldLabelModifier = withPrefix "position"})+ (Proxy :: Proxy Position)+ "test/PositionDecoderWithOptions.elm"++toElmEncoderSpec :: Hspec.Spec+toElmEncoderSpec =+ describe "Convert to Elm encoders." $+ do it "toElmEncoderSource Post" $+ shouldMatchEncoderSource defaultOptions+ (Proxy :: Proxy Post)+ "test/PostEncoder.elm"+ it "toElmEncoderSource Comment" $+ shouldMatchEncoderSource defaultOptions+ (Proxy :: Proxy Comment)+ "test/CommentEncoder.elm"+ it "toElmEncoderSource Position" $+ shouldMatchEncoderSource defaultOptions+ (Proxy :: Proxy Position)+ "test/PositionEncoder.elm"+ it "toElmEncoderSourceWithOptions Post" $+ shouldMatchEncoderSource+ (defaultOptions {fieldLabelModifier = withPrefix "post"})+ (Proxy :: Proxy Post)+ "test/PostEncoderWithOptions.elm"+ it "toElmEncoderSourceWithOptions Comment" $+ shouldMatchEncoderSource+ (defaultOptions {fieldLabelModifier = withPrefix "comment"})+ (Proxy :: Proxy Comment)+ "test/CommentEncoderWithOptions.elm"+ it "toElmEncoderSourceWithOptions Position" $+ shouldMatchEncoderSource+ (defaultOptions {fieldLabelModifier = withPrefix "position"})+ (Proxy :: Proxy Position)+ "test/PositionEncoderWithOptions.elm"++shouldMatchTypeSource+ :: ElmType a+ => Options -> a -> FilePath -> IO ()+shouldMatchTypeSource options x =+ shouldMatchFile . printf outputWrapping $ toElmTypeSourceWith options x++shouldMatchDecoderSource+ :: ElmType a+ => Options -> a -> FilePath -> IO ()+shouldMatchDecoderSource options x =+ shouldMatchFile . printf outputWrapping $ toElmDecoderSourceWith options x++shouldMatchEncoderSource+ :: ElmType a+ => Options -> a -> FilePath -> IO ()+shouldMatchEncoderSource options x =+ shouldMatchFile . printf outputWrapping $ toElmEncoderSourceWith options x++outputWrapping :: String+outputWrapping = "module Main (..) where\n\n\n%s\n"++shouldMatchFile :: String -> FilePath -> IO ()+shouldMatchFile actual fileExpected =+ do source <- readFile fileExpected+ actual `shouldBe` source++initCap :: String -> String+initCap [] = []+initCap (c:cs) = Data.Char.toUpper c : cs++withPrefix :: String -> String -> String+withPrefix prefix s = prefix ++ initCap s++k = hspec spec
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}