purescript-bridge 0.13.0.0 → 0.14.0.0
raw patch · 7 files changed
+227/−49 lines, 7 files
Files
- purescript-bridge.cabal +1/−1
- src/Language/PureScript/Bridge/Builder.hs +0/−1
- src/Language/PureScript/Bridge/CodeGenSwitches.hs +33/−2
- src/Language/PureScript/Bridge/PSTypes.hs +0/−1
- src/Language/PureScript/Bridge/Printer.hs +97/−35
- src/Language/PureScript/Bridge/SumType.hs +2/−2
- test/Spec.hs +94/−7
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.13.0.0+version: 0.14.0.0 -- A short (one-line) description of the package. synopsis: Generate PureScript data types from Haskell data types
src/Language/PureScript/Bridge/Builder.hs view
@@ -43,7 +43,6 @@ import Control.Monad.Trans.Reader (Reader, ReaderT (..), runReader) import Data.Maybe (fromMaybe)-import Data.Monoid import qualified Data.Text as T import Language.PureScript.Bridge.TypeInfo
src/Language/PureScript/Bridge/CodeGenSwitches.hs view
@@ -1,28 +1,43 @@ -- | General switches for the code generation, such as generating profunctor-lenses or not module Language.PureScript.Bridge.CodeGenSwitches ( Settings (..)+ , ForeignOptions(..) , defaultSettings+ , purs_0_11_settings , Switch , getSettings , defaultSwitch , noLenses, genLenses+ , useGen, useGenRep+ , genForeign, noForeign ) where import Data.Monoid (Endo(..)) -- | General settings for code generation-newtype Settings = Settings+data Settings = Settings { generateLenses :: Bool -- ^use purescript-profunctor-lens for generated PS-types?+ , genericsGenRep :: Bool -- ^generate generics using purescript-generics-rep instead of purescript-generics+ , generateForeign :: Maybe ForeignOptions -- ^generate Foreign.Generic Encode and Decode instances } deriving (Eq, Show) +data ForeignOptions = ForeignOptions+ { unwrapSingleConstructors :: Bool+ }+ deriving (Eq, Show) -- | Settings to generate Lenses defaultSettings :: Settings-defaultSettings = Settings True+defaultSettings = Settings True True Nothing +-- |settings for purescript 0.11.x+purs_0_11_settings :: Settings+purs_0_11_settings = Settings True False Nothing++ -- | you can `mappend` switches to control the code generation type Switch = Endo Settings @@ -45,3 +60,19 @@ -- | Switch on the generatation of profunctor-lenses genLenses :: Switch genLenses = Endo $ \settings -> settings { generateLenses = True }+++-- | Generate generics using purescript-generics-rep+useGenRep :: Switch+useGenRep = Endo $ \settings -> settings { genericsGenRep = True }+++-- | Generate generics using purescript-generics+useGen :: Switch+useGen = Endo $ \settings -> settings { genericsGenRep = False }++genForeign :: ForeignOptions -> Switch+genForeign opts = Endo $ \settings -> settings { generateForeign = Just opts }++noForeign :: Switch+noForeign = Endo $ \settings -> settings { generateForeign = Nothing }
src/Language/PureScript/Bridge/PSTypes.hs view
@@ -8,7 +8,6 @@ module Language.PureScript.Bridge.PSTypes where import Control.Lens (views)-import Data.Monoid import qualified Data.Text as T import Control.Monad.Reader.Class
src/Language/PureScript/Bridge/Printer.hs view
@@ -8,7 +8,6 @@ import Control.Monad import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map-import Data.Monoid import Data.Set (Set) import Data.Maybe (isJust) import qualified Data.Set as Set@@ -61,37 +60,47 @@ "-- File auto generated by purescript-bridge! --" : "module " <> psModuleName m <> " where\n" : map importLineToText allImports- ++ [ ""+ <> [ "" , "import Prelude"- , "import Data.Generic (class Generic)" , "" ]- ++ map (sumTypeToText settings) (psTypes m)+ <> map (sumTypeToText settings) (psTypes m) where- otherImports = - if Switches.generateLenses settings then- importsFromList _lensImports- else- importsFromList _noLensImports+ otherImports = importsFromList (_lensImports settings <> _genericsImports settings <> _foreignImports settings) allImports = Map.elems $ mergeImportLines otherImports (psImportLines m) -_lensImports :: [ImportLine]-_lensImports = [- ImportLine "Data.Maybe" $ Set.fromList ["Maybe(..)"]- , ImportLine "Data.Lens" $ Set.fromList ["Iso'", "Prism'", "Lens'", "prism'", "lens"]- , ImportLine "Data.Lens.Record" $ Set.fromList ["prop"]- , ImportLine "Data.Lens.Iso.Newtype" $ Set.fromList ["_Newtype"]- , ImportLine "Data.Symbol" $ Set.fromList ["SProxy(SProxy)"]- , ImportLine "Data.Newtype" $ Set.fromList ["class Newtype"]- ] -_noLensImports :: [ImportLine]-_noLensImports = [- ImportLine "Data.Maybe" $ Set.fromList ["Maybe(..)"]- , ImportLine "Data.Newtype" $ Set.fromList ["class Newtype"]- ]- +_genericsImports :: Switches.Settings -> [ImportLine]+_genericsImports settings+ | Switches.genericsGenRep settings =+ [ ImportLine "Data.Generic.Rep" $ Set.fromList ["class Generic"] ]+ | otherwise =+ [ ImportLine "Data.Generic" $ Set.fromList ["class Generic"] ] ++_lensImports :: Switches.Settings -> [ImportLine]+_lensImports settings+ | Switches.generateLenses settings =+ [ ImportLine "Data.Maybe" $ Set.fromList ["Maybe(..)"]+ , ImportLine "Data.Lens" $ Set.fromList ["Iso'", "Prism'", "Lens'", "prism'", "lens"]+ , ImportLine "Data.Lens.Record" $ Set.fromList ["prop"]+ , ImportLine "Data.Lens.Iso.Newtype" $ Set.fromList ["_Newtype"]+ , ImportLine "Data.Symbol" $ Set.fromList ["SProxy(SProxy)"]+ , ImportLine "Data.Newtype" $ Set.fromList ["class Newtype"]+ ]+ | otherwise =+ [ ImportLine "Data.Maybe" $ Set.fromList ["Maybe(..)"]+ , ImportLine "Data.Newtype" $ Set.fromList ["class Newtype"]+ ]++_foreignImports :: Switches.Settings -> [ImportLine]+_foreignImports settings+ | (isJust . Switches.generateForeign) settings = + [ ImportLine "Foreign.Generic" $ Set.fromList ["defaultOptions", "genericDecode", "genericEncode"]+ , ImportLine "Foreign.Class" $ Set.fromList ["class Decode", "class Encode"]+ ]+ | otherwise = []+ importLineToText :: ImportLine -> Text importLineToText l = "import " <> importModule l <> " (" <> typeList <> ")" where@@ -99,27 +108,56 @@ sumTypeToText :: Switches.Settings -> SumType 'PureScript -> Text sumTypeToText settings st =- sumTypeToTypeDecls st <> additionalCode+ sumTypeToTypeDecls settings st <> additionalCode where additionalCode = if Switches.generateLenses settings then lenses else mempty lenses = "\n" <> sep <> "\n" <> sumTypeToOptics st <> sep sep = T.replicate 80 "-" -sumTypeToTypeDecls :: SumType 'PureScript -> Text-sumTypeToTypeDecls st@(SumType t cs _) = T.unlines $+sumTypeToTypeDecls :: Switches.Settings -> SumType 'PureScript -> Text+sumTypeToTypeDecls settings (SumType t cs is) = T.unlines $ dataOrNewtype <> " " <> typeInfoToText True t <> " =" : " " <> T.intercalate "\n | " (map (constructorToText 4) cs) <> "\n"- : instances st+ : instances settings (SumType t cs (filter genForeign is)) where dataOrNewtype = if isJust (nootype cs) then "newtype" else "data"+ genForeign Encode = (isJust . Switches.generateForeign) settings+ genForeign Decode = (isJust . Switches.generateForeign) settings+ genForeign _ = True --- | Given a Purescript type, generate `derive instance` lines for typeclass+-- | Given a Purescript type, generate instances for typeclass -- instances it claims to have.-instances :: SumType 'PureScript -> [Text]-instances st@(SumType t _ is) = map go is+instances :: Switches.Settings -> SumType 'PureScript -> [Text]+instances settings st@(SumType t _ is) = map go is where go :: Instance -> Text+ go Encode = "instance encode" <> _typeName t <> " :: " <> extras <> "Encode " <> typeInfoToText False t <> " where\n" <>+ " encode = genericEncode $ defaultOptions" <> encodeOpts+ where+ encodeOpts = case Switches.generateForeign settings of+ Nothing -> ""+ Just fopts -> " { unwrapSingleConstructors = " <> (T.toLower . T.pack . show . Switches.unwrapSingleConstructors) fopts <> " }"+ stpLength = length sumTypeParameters+ extras | stpLength == 0 = mempty+ | otherwise = bracketWrap constraintsInner <> " => "+ sumTypeParameters = filter (isTypeParam t) . Set.toList $ getUsedTypes st+ constraintsInner = T.intercalate ", " $ map instances sumTypeParameters+ instances params = genericInstance settings params <> ", " <> encodeInstance params+ bracketWrap x = "(" <> x <> ")"+ go Decode = "instance decode" <> _typeName t <> " :: " <> extras <> "Decode " <> typeInfoToText False t <> " where\n" <>+ " decode = genericDecode $ defaultOptions" <> decodeOpts+ where+ decodeOpts = case Switches.generateForeign settings of+ Nothing -> ""+ Just fopts -> " { unwrapSingleConstructors = " <> (T.toLower . T.pack . show . Switches.unwrapSingleConstructors) fopts <> " }"+ stpLength = length sumTypeParameters+ extras | stpLength == 0 = mempty+ | otherwise = bracketWrap constraintsInner <> " => "+ sumTypeParameters = filter (isTypeParam t) . Set.toList $ getUsedTypes st+ constraintsInner = T.intercalate ", " $ map instances sumTypeParameters+ instances params = genericInstance settings params <> ", " <> decodeInstance params+ bracketWrap x = "(" <> x <> ")" go i = "derive instance " <> T.toLower c <> _typeName t <> " :: " <> extras i <> c <> " " <> typeInfoToText False t <> postfix i where c = T.pack $ show i extras Generic | stpLength == 0 = mempty@@ -127,14 +165,31 @@ | otherwise = bracketWrap genericConstraintsInner <> " => " extras _ = "" postfix Newtype = " _"+ postfix Generic+ | Switches.genericsGenRep settings = " _"+ | otherwise = "" postfix _ = "" stpLength = length sumTypeParameters- sumTypeParameters = filter isTypeParam . Set.toList $ getUsedTypes st- isTypeParam typ = _typeName typ `elem` map _typeName (_typeParameters t)- genericConstraintsInner = T.intercalate ", " $ map genericInstance sumTypeParameters- genericInstance = ("Generic " <>) . typeInfoToText False+ sumTypeParameters = filter (isTypeParam t) . Set.toList $ getUsedTypes st+ genericConstraintsInner = T.intercalate ", " $ map (genericInstance settings) sumTypeParameters bracketWrap x = "(" <> x <> ")" +isTypeParam :: PSType -> PSType -> Bool+isTypeParam t typ = _typeName typ `elem` map _typeName (_typeParameters t)++encodeInstance :: PSType -> Text+encodeInstance params = "Encode " <> typeInfoToText False params++decodeInstance :: PSType -> Text+decodeInstance params = "Decode " <> typeInfoToText False params++genericInstance :: Switches.Settings -> PSType -> Text+genericInstance settings params =+ if not (Switches.genericsGenRep settings) then+ "Generic " <> typeInfoToText False params+ else+ "Generic " <> typeInfoToText False params <> " r" <> mergedTypeInfoToText params+ sumTypeToOptics :: SumType 'PureScript -> Text sumTypeToOptics st = constructorOptics st <> recordOptics st @@ -266,6 +321,13 @@ pLength = length params needParens = not topLevel && pLength > 0 textParameters = map (typeInfoToText False) params++mergedTypeInfoToText :: PSType -> Text+mergedTypeInfoToText t =+ _typeName t <> T.concat textParameters+ where+ params = _typeParameters t+ textParameters = map mergedTypeInfoToText params sumTypesToModules :: Modules -> [SumType 'PureScript] -> Modules sumTypesToModules = foldr sumTypeToModule
src/Language/PureScript/Bridge/SumType.hs view
@@ -55,12 +55,12 @@ -- 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 p = SumType (mkTypeInfo p) constructors (Generic : maybeToList (nootype constructors))+mkSumType p = SumType (mkTypeInfo p) constructors (Encode : Decode : Generic : maybeToList (nootype constructors)) where constructors = gToConstructors (from (undefined :: t)) -- | Purescript typeclass instances that can be generated for your Haskell types.-data Instance = Generic | Newtype | Eq | Ord deriving (Eq, Show)+data Instance = Encode | Decode | Generic | Newtype | Eq | Ord deriving (Eq, Show) -- | The Purescript typeclass `Newtype` might be derivable if the original -- Haskell type was a simple type wrapper.
test/Spec.hs view
@@ -25,8 +25,8 @@ allTests :: Spec allTests = do- describe "buildBridge" $ do- let settings = defaultSettings+ describe "buildBridge for purescript 0.12" $ do+ let settings = purs_0_11_settings it "tests with Int" $ let bst = buildBridge defaultBridge (mkTypeInfo (Proxy :: Proxy Int)) ti = TypeInfo { _typePackage = ""@@ -51,7 +51,7 @@ ] } ]- [Eq, Ord, Generic]+ [Eq, Ord, Encode, Decode, Generic] in bst `shouldBe` st it "tests generation of for custom type Foo" $ let prox = Proxy :: Proxy Foo@@ -97,6 +97,7 @@ , "module TestData where" , "" , "import Data.Either (Either)"+ , "import Data.Generic (class Generic)" , "import Data.Lens (Iso', Lens', Prism', lens, prism')" , "import Data.Lens.Iso.Newtype (_Newtype)" , "import Data.Lens.Record (prop)"@@ -105,7 +106,6 @@ , "import Data.Symbol (SProxy(SProxy))" , "" , "import Prelude"- , "import Data.Generic (class Generic)" , "" , "data Bar a b m c =" , " Bar1 (Maybe a)"@@ -291,8 +291,8 @@ recTypeOptics = recordOptics recType in recTypeOptics `shouldBe` "" -- No record optics for multi-constructors - describe "buildBridge without lens-code-gen" $ do- let settings = getSettings noLenses+ describe "buildBridge without lens-code-gen for purescript 0.11" $ do+ let settings = getSettings (noLenses <> useGen) it "tests generation of for custom type Foo" $ let proxy = Proxy :: Proxy Foo recType = bridgeSumType (buildBridge defaultBridge) (order proxy $ mkSumType proxy)@@ -315,11 +315,11 @@ , "module TestData where" , "" , "import Data.Either (Either)"+ , "import Data.Generic (class Generic)" , "import Data.Maybe (Maybe, Maybe(..))" , "import Data.Newtype (class Newtype)" , "" , "import Prelude"- , "import Data.Generic (class Generic)" , "" , "data Bar a b m c =" , " Bar1 (Maybe a)"@@ -374,6 +374,93 @@ , " SingleProduct String Int" , "" , "derive instance genericSingleProduct :: Generic SingleProduct"+ ]+ in recTypeText `shouldBe` txt+++ describe "buildBridge without lens-code-gen and generics-rep" $ do+ let settings = getSettings (noLenses <> useGenRep)+ it "tests generation of for custom type Foo" $+ let proxy = Proxy :: Proxy Foo+ recType = bridgeSumType (buildBridge defaultBridge) (order proxy $ mkSumType proxy)+ recTypeText = sumTypeToText settings recType+ txt = T.unlines [ "data Foo ="+ , " Foo"+ , " | Bar Int"+ , " | FooBar Int String"+ , ""+ , "derive instance eqFoo :: Eq Foo"+ , "derive instance ordFoo :: Ord Foo"+ , "derive instance genericFoo :: Generic Foo _"+ ]+ in recTypeText `shouldBe` txt+ it "tests the generation of a whole (dummy) module" $+ let advanced' = bridgeSumType (buildBridge defaultBridge) (mkSumType (Proxy :: Proxy (Bar A B M1 C)))+ modules = sumTypeToModule advanced' Map.empty+ m = head . map (moduleToText settings) . Map.elems $ modules+ txt = T.unlines [ "-- File auto generated by purescript-bridge! --"+ , "module TestData where"+ , ""+ , "import Data.Either (Either)"+ , "import Data.Generic.Rep (class Generic)"+ , "import Data.Maybe (Maybe, Maybe(..))"+ , "import Data.Newtype (class Newtype)"+ , ""+ , "import Prelude"+ , ""+ , "data Bar a b m c ="+ , " Bar1 (Maybe a)"+ , " | Bar2 (Either a b)"+ , " | Bar3 a"+ , " | Bar4 {"+ , " myMonadicResult :: m b"+ , " }"+ , ""+ , "derive instance genericBar :: (Generic a ra, Generic b rb, Generic (m b) rmb) => Generic (Bar a b m c) _"+ , ""+ ]+ in m `shouldBe` txt+ it "tests generation of newtypes for record data type" $+ let recType' = bridgeSumType (buildBridge defaultBridge) (mkSumType (Proxy :: Proxy (SingleRecord A B)))+ recTypeText = sumTypeToText settings recType'+ txt = T.unlines [ "newtype SingleRecord a b ="+ , " SingleRecord {"+ , " _a :: a"+ , " , _b :: b"+ , " , c :: String"+ , " }"+ , ""+ , "derive instance genericSingleRecord :: (Generic a ra, Generic b rb) => Generic (SingleRecord a b) _"+ , "derive instance newtypeSingleRecord :: Newtype (SingleRecord a b) _"+ ]+ in recTypeText `shouldBe` txt+ it "tests generation of newtypes for haskell newtype" $+ let recType' = bridgeSumType (buildBridge defaultBridge) (mkSumType (Proxy :: Proxy SomeNewtype))+ recTypeText = sumTypeToText settings recType'+ txt = T.unlines [ "newtype SomeNewtype ="+ , " SomeNewtype Int"+ , ""+ , "derive instance genericSomeNewtype :: Generic SomeNewtype _"+ , "derive instance newtypeSomeNewtype :: Newtype SomeNewtype _"+ ]+ in recTypeText `shouldBe` txt+ it "tests generation of newtypes for haskell data type with one argument" $+ let recType' = bridgeSumType (buildBridge defaultBridge) (mkSumType (Proxy :: Proxy SingleValueConstr))+ recTypeText = sumTypeToText settings recType'+ txt = T.unlines [ "newtype SingleValueConstr ="+ , " SingleValueConstr Int"+ , ""+ , "derive instance genericSingleValueConstr :: Generic SingleValueConstr _"+ , "derive instance newtypeSingleValueConstr :: Newtype SingleValueConstr _"+ ]+ in recTypeText `shouldBe` txt+ it "tests generation for haskell data type with one constructor, two arguments" $+ let recType' = bridgeSumType (buildBridge defaultBridge) (mkSumType (Proxy :: Proxy SingleProduct))+ recTypeText = sumTypeToText settings recType'+ txt = T.unlines [ "data SingleProduct ="+ , " SingleProduct String Int"+ , ""+ , "derive instance genericSingleProduct :: Generic SingleProduct _" ] in recTypeText `shouldBe` txt