purescript-bridge 0.7.0.0 → 0.7.0.1
raw patch · 4 files changed
+157/−65 lines, 4 filesdep +hspecdep +hspec-expectations-pretty-diffdep ~base
Dependencies added: hspec, hspec-expectations-pretty-diff
Dependency ranges changed: base
Files
- purescript-bridge.cabal +14/−11
- src/Language/PureScript/Bridge/SumType.hs +20/−20
- test/Spec.hs +59/−34
- test/TestData.hs +64/−0
purescript-bridge.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.7.0.0+version: 0.7.0.1 -- A short (one-line) description of the package. synopsis: Generate PureScript data types from Haskell data types@@ -70,7 +70,7 @@ -- other-extensions: -- Other library packages from which modules are imported.- build-depends: base >=4.8 && <4.9+ build-depends: base >=4.8 && <= 5.1 , containers , directory , filepath@@ -90,12 +90,15 @@ Test-Suite tests- type: exitcode-stdio-1.0- main-is: Spec.hs- build-depends: base- , containers- -- , HUnit- , purescript-bridge- , text- hs-source-dirs: test- default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules: TestData+ build-depends: base+ , containers+ , purescript-bridge+ , text+ , hspec+ , hspec-expectations-pretty-diff++ hs-source-dirs: test+ default-language: Haskell2010
src/Language/PureScript/Bridge/SumType.hs view
@@ -34,7 +34,7 @@ import Language.PureScript.Bridge.TypeInfo -- | Generic representation of your Haskell types.-data SumType (lang :: Language) = SumType (TypeInfo lang) [DataConstructor lang] deriving Show+data SumType (lang :: Language) = SumType (TypeInfo lang) [DataConstructor lang] deriving (Show, Eq) -- | TypInfo lens for 'SumType'. sumTypeInfo :: Functor f => (TypeInfo lang -> f (TypeInfo lang) ) -> SumType lang -> f (SumType lang)@@ -47,21 +47,22 @@ -- | Create a representation of your sum (and product) types, -- for doing type translations and writing it out to your PureScript modules. -- In order to get the type information we use a dummy variable of type 'Proxy' (YourType).-mkSumType :: forall t. (Generic t, Typeable t, GDataConstructor (Rep t)) => Proxy t -> SumType 'Haskell+mkSumType :: forall t. (Generic t, Typeable t, GDataConstructor (Rep t))+ => Proxy t -> SumType 'Haskell mkSumType p = SumType (mkTypeInfo p) constructors where constructors = gToConstructors (from (undefined :: t)) -data DataConstructor (lang :: Language) = DataConstructor {- _sigConstructor :: !Text-, _sigValues :: !(Either [TypeInfo lang] [RecordEntry lang])-} deriving Show+data DataConstructor (lang :: Language) =+ DataConstructor { _sigConstructor :: !Text -- ^ e.g. `Left`/`Right` for `Either`+ , _sigValues :: !(Either [TypeInfo lang] [RecordEntry lang])+ } deriving (Show, Eq) -data RecordEntry (lang :: Language) = RecordEntry {- _recLabel :: !Text-, _recValue :: !(TypeInfo lang)-} deriving Show+data RecordEntry (lang :: Language) =+ RecordEntry { _recLabel :: !Text -- ^ e.g. `runState` for `State`+ , _recValue :: !(TypeInfo lang)+ } deriving (Show, Eq) class GDataConstructor f where gToConstructors :: f a -> [DataConstructor 'Haskell]@@ -73,23 +74,22 @@ gToConstructors (M1 c) = gToConstructors c instance (GDataConstructor a, GDataConstructor b) => GDataConstructor (a :+: b) where- gToConstructors (_ :: (a :+: b) f) = gToConstructors (undefined :: a f) ++ gToConstructors (undefined :: b f)+ gToConstructors (_ :: (a :+: b) f) = gToConstructors (undefined :: a f)+ ++ gToConstructors (undefined :: b f) instance (Constructor a, GRecordEntry b) => GDataConstructor (C1 a b) where- gToConstructors c@(M1 r) = [- DataConstructor {- _sigConstructor = constructor- , _sigValues = values- }- ]+ gToConstructors c@(M1 r) = [ DataConstructor { _sigConstructor = constructor+ , _sigValues = values }+ ] where constructor = T.pack $ conName c values = if conIsRecord c- then Right $ gToRecordEntries r- else Left $ map _recValue $ gToRecordEntries r+ then Right $ gToRecordEntries r+ else Left $ map _recValue $ gToRecordEntries r instance (GRecordEntry a, GRecordEntry b) => GRecordEntry (a :*: b) where- gToRecordEntries (_ :: (a :*: b) f) = gToRecordEntries (undefined :: a f) ++ gToRecordEntries (undefined :: b f)+ gToRecordEntries (_ :: (a :*: b) f) = gToRecordEntries (undefined :: a f)+ ++ gToRecordEntries (undefined :: b f) instance GRecordEntry U1 where
test/Spec.hs view
@@ -1,55 +1,80 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeSynonymInstances #-}-+{-# LANGUAGE CPP #-} module Main where +import Control.Monad (unless) import qualified Data.Map as Map import Data.Proxy-import Data.Text (Text) import qualified Data.Text as T-import Data.Typeable-import GHC.Generics (Generic) import Language.PureScript.Bridge-import Language.PureScript.Bridge.PSTypes import Language.PureScript.Bridge.TypeParameters+import Test.Hspec (Spec, hspec, describe, it)+import Test.Hspec.Expectations.Pretty +import TestData --- Check that examples compile:-textBridge :: BridgePart-textBridge = do- typeName ^== "Text"- typeModule ^== "Data.Text.Internal" <|> typeModule ^== "Data.Text.Internal.Lazy"- return psString -stringBridge :: BridgePart-stringBridge = do- haskType ^== mkTypeInfo (Proxy :: Proxy String)- return psString+main :: IO ()+main = hspec $ do allTests -data Foo = Foo | Bar Int | FooBar Int Text deriving (Generic, Typeable, Show) -data Bar a b m = Bar1 (Maybe a) | Bar2 (Either a b) | Bar3 a- | Bar4 {- myMonadicResult :: m b- } deriving (Generic, Typeable, Show)+allTests :: Spec+allTests =+ describe "buildBridge" $ do+ it "tests with Int" $+ let bst = buildBridge defaultBridge (mkTypeInfo (Proxy :: Proxy Int))+ ti = TypeInfo { _typePackage = "purescript-prim"+ , _typeModule = "Prim"+ , _typeName = "Int"+ , _typeParameters = []}+ in bst `shouldBe` ti+ it "tests with custom type Foo" $+ let bst = bridgeSumType (buildBridge defaultBridge) (mkSumType (Proxy :: Proxy Foo))+ st = SumType+ TypeInfo { _typePackage = "" , _typeModule = "TestData" , _typeName = "Foo" , _typeParameters = [] }+ [ DataConstructor { _sigConstructor = "Foo" , _sigValues = Left [] }+ , DataConstructor+ { _sigConstructor = "Bar"+ , _sigValues = Left [ TypeInfo { _typePackage = "purescript-prim" , _typeModule = "Prim" , _typeName = "Int" , _typeParameters = [] } ]+ }+ , DataConstructor+ { _sigConstructor = "FooBar"+ , _sigValues = Left [ TypeInfo { _typePackage = "purescript-prim" , _typeModule = "Prim" , _typeName = "Int" , _typeParameters = [] }+ , TypeInfo { _typePackage = "purescript-prim" , _typeModule = "Prim" , _typeName = "String" , _typeParameters = [] }+ ]+ }+ ]+ in bst `shouldBe` st+ it "tests the generation of a whole (dummy) module" $+ let advanced = bridgeSumType (buildBridge defaultBridge) (mkSumType (Proxy :: Proxy (Bar A B M1)))+ modules = sumTypeToModule advanced Map.empty+ m = head . map moduleToText . Map.elems $ modules+ txt = T.unlines [ "-- File auto generated by purescript-bridge! --"+ , "module TestData where"+ , ""+ , "import Data.Either (Either)"+ , "import Data.Maybe (Maybe)"+ , ""+ , "import Data.Generic (class Generic)"+ , ""+ , ""+ , "data Bar a b m ="+ , " Bar1 (Maybe a)"+ , " | Bar2 (Either a b)"+ , " | Bar3 a"+ , " | Bar4 {"+ , " myMonadicResult :: m b"+ , " }"+ , ""+ , "derive instance genericBar :: Generic Bar"+ , ""+ ]+ in m `shouldBe` txt -main :: IO ()-main = do- let r = buildBridge defaultBridge (mkTypeInfo (Proxy :: Proxy Int))- let r2 = bridgeSumType (buildBridge defaultBridge) (mkSumType (Proxy :: Proxy Foo))- putStrLn "Bridge a single int: "- print r- putStrLn "\nBridge Foo:"- print r2- let advanced = bridgeSumType (buildBridge defaultBridge) (mkSumType (Proxy :: Proxy (Bar A B M1)))- let modules = sumTypeToModule advanced Map.empty- let m = head . map moduleToText . Map.elems $ modules- putStrLn "\n Complete module for Bar type:\n"- putStrLn $ T.unpack m
+ test/TestData.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeSynonymInstances #-}+++module TestData where++import Data.Proxy+import Data.Text (Text)+import Data.Typeable+import GHC.Generics (Generic)+import Language.PureScript.Bridge+import Language.PureScript.Bridge.PSTypes++++-- Check that examples compile:+textBridge :: BridgePart+textBridge = do+ typeName ^== "Text"+ typeModule ^== "Data.Text.Internal" <|> typeModule ^== "Data.Text.Internal.Lazy"+ return psString++stringBridge :: BridgePart+stringBridge = do+ haskType ^== mkTypeInfo (Proxy :: Proxy String)+ return psString++data Foo = Foo+ | Bar Int+ | FooBar Int Text+ deriving (Generic, Typeable, Show)++data Test = TestIntInt Int Int+ | TestBool {bool :: Bool}+ | TestVoid+ deriving (Generic, Typeable, Show)++data Bar a b m = Bar1 (Maybe a) | Bar2 (Either a b) | Bar3 a+ | Bar4 { myMonadicResult :: m b }+ deriving (Generic, Typeable, Show)+++a :: HaskellType+a = mkTypeInfo (Proxy :: Proxy (Either String Int))++applyBridge :: FullBridge+applyBridge = buildBridge defaultBridge++psA :: PSType+psA = applyBridge a++b :: SumType 'Haskell+b = mkSumType (Proxy :: Proxy (Either String Int))++t :: TypeInfo 'PureScript+cs :: [DataConstructor 'PureScript]+psB :: SumType 'PureScript+psB@(SumType t cs) = bridgeSumType (buildBridge defaultBridge) b+