diff --git a/purescript-bridge.cabal b/purescript-bridge.cabal --- a/purescript-bridge.cabal +++ b/purescript-bridge.cabal @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.12.0.0 +version: 0.13.0.0 -- A short (one-line) description of the package. synopsis: Generate PureScript data types from Haskell data types @@ -54,6 +54,7 @@ library -- Modules exported by the library. exposed-modules: Language.PureScript.Bridge + , Language.PureScript.Bridge.CodeGenSwitches , Language.PureScript.Bridge.Builder , Language.PureScript.Bridge.Primitives , Language.PureScript.Bridge.Printer diff --git a/src/Language/PureScript/Bridge.hs b/src/Language/PureScript/Bridge.hs --- a/src/Language/PureScript/Bridge.hs +++ b/src/Language/PureScript/Bridge.hs @@ -6,6 +6,8 @@ , defaultBridge , module Bridge , writePSTypes + , writePSTypesWith + , defaultSwitch, noLenses, genLenses ) where @@ -15,12 +17,13 @@ import qualified Data.Text.IO as T -import Language.PureScript.Bridge.Builder as Bridge -import Language.PureScript.Bridge.Primitives as Bridge -import Language.PureScript.Bridge.Printer as Bridge -import Language.PureScript.Bridge.SumType as Bridge -import Language.PureScript.Bridge.Tuple as Bridge -import Language.PureScript.Bridge.TypeInfo as Bridge +import Language.PureScript.Bridge.Builder as Bridge +import Language.PureScript.Bridge.Primitives as Bridge +import Language.PureScript.Bridge.Printer as Bridge +import Language.PureScript.Bridge.SumType as Bridge +import Language.PureScript.Bridge.Tuple as Bridge +import Language.PureScript.Bridge.TypeInfo as Bridge +import Language.PureScript.Bridge.CodeGenSwitches as Switches -- | Your entry point to this library and quite likely all you will need. -- Make sure all your types derive `Generic` and `Typeable`. @@ -75,14 +78,34 @@ -- == /WARNING/: -- This function overwrites files - make backups or use version control! writePSTypes :: FilePath -> FullBridge -> [SumType 'Haskell] -> IO () -writePSTypes root br sts = do - let bridged = map (bridgeSumType br) sts - let modules = M.elems $ sumTypesToModules M.empty bridged - mapM_ (printModule root) modules +writePSTypes = writePSTypesWith Switches.defaultSwitch + + +-- | Works like `writePSTypes` but you can add additional switches to control the generation of your PureScript code +-- +-- == Switches/Settings: +-- +-- - `noLenses` and `genLenses` to control if the `purescript-profunctor-lenses` are generated for your types +-- +-- == /WARNING/: +-- This function overwrites files - make backups or use version control! +writePSTypesWith :: Switches.Switch -> FilePath -> FullBridge -> [SumType 'Haskell] -> IO () +writePSTypesWith switch root bridge sts = do + mapM_ (printModule settings root) modules T.putStrLn "The following purescript packages are needed by the generated code:\n" - let packages = Set.insert "purescript-profunctor-lenses" $ sumTypesToNeededPackages bridged mapM_ (T.putStrLn . mappend " - ") packages T.putStrLn "\nSuccessfully created your PureScript modules!" + + where + settings = Switches.getSettings switch + bridged = map (bridgeSumType bridge) sts + modules = M.elems $ sumTypesToModules M.empty bridged + packages = + if Switches.generateLenses settings then + Set.insert "purescript-profunctor-lenses" $ sumTypesToNeededPackages bridged + else + sumTypesToNeededPackages bridged + -- | Translate all 'TypeInfo' values in a 'SumType' to PureScript types. -- diff --git a/src/Language/PureScript/Bridge/Builder.hs b/src/Language/PureScript/Bridge/Builder.hs --- a/src/Language/PureScript/Bridge/Builder.hs +++ b/src/Language/PureScript/Bridge/Builder.hs @@ -89,7 +89,7 @@ data BridgeData = BridgeData { -- | The Haskell type to translate. _haskType :: HaskellType - -- | Reference to the bride itself, needed for translation of type constructors. + -- | Reference to the bridge itself, needed for translation of type constructors. , _fullBridge :: FullBridge } diff --git a/src/Language/PureScript/Bridge/CodeGenSwitches.hs b/src/Language/PureScript/Bridge/CodeGenSwitches.hs new file mode 100644 --- /dev/null +++ b/src/Language/PureScript/Bridge/CodeGenSwitches.hs @@ -0,0 +1,47 @@ +-- | General switches for the code generation, such as generating profunctor-lenses or not +module Language.PureScript.Bridge.CodeGenSwitches + ( Settings (..) + , defaultSettings + , Switch + , getSettings + , defaultSwitch + , noLenses, genLenses + ) where + + +import Data.Monoid (Endo(..)) + +-- | General settings for code generation +newtype Settings = Settings + { generateLenses :: Bool -- ^use purescript-profunctor-lens for generated PS-types? + } + deriving (Eq, Show) + + +-- | Settings to generate Lenses +defaultSettings :: Settings +defaultSettings = Settings True + + +-- | you can `mappend` switches to control the code generation +type Switch = Endo Settings + + +-- | Translate switches into settings +getSettings :: Switch -> Settings +getSettings switch = appEndo switch defaultSettings + + +-- | Default switches include code generation for lenses +defaultSwitch :: Switch +defaultSwitch = mempty + + +-- | Switch off the generatation of profunctor-lenses +noLenses :: Switch +noLenses = Endo $ \settings -> settings { generateLenses = False } + + +-- | Switch on the generatation of profunctor-lenses +genLenses :: Switch +genLenses = Endo $ \settings -> settings { generateLenses = True } diff --git a/src/Language/PureScript/Bridge/PSTypes.hs b/src/Language/PureScript/Bridge/PSTypes.hs --- a/src/Language/PureScript/Bridge/PSTypes.hs +++ b/src/Language/PureScript/Bridge/PSTypes.hs @@ -18,11 +18,11 @@ -- | Uses type parameters from 'haskType' (bridged). psArray :: MonadReader BridgeData m => m PSType -psArray = TypeInfo "purescript-prim" "Prim" "Array" <$> psTypeParameters +psArray = TypeInfo "" "Prim" "Array" <$> psTypeParameters psBool :: PSType psBool = TypeInfo { - _typePackage = "purescript-prim" + _typePackage = "" , _typeModule = "Prim" , _typeName = "Boolean" , _typeParameters = [] @@ -34,7 +34,7 @@ psInt :: PSType psInt = TypeInfo { - _typePackage = "purescript-prim" + _typePackage = "" , _typeModule = "Prim" , _typeName = "Int" , _typeParameters = [] @@ -42,7 +42,7 @@ psNumber :: PSType psNumber = TypeInfo { - _typePackage = "purescript-prim" + _typePackage = "" , _typeModule = "Prim" , _typeName = "Number" , _typeParameters = [] @@ -54,7 +54,7 @@ psString :: PSType psString = TypeInfo { - _typePackage = "purescript-prim" + _typePackage = "" , _typeModule = "Prim" , _typeName = "String" , _typeParameters = [] diff --git a/src/Language/PureScript/Bridge/Printer.hs b/src/Language/PureScript/Bridge/Printer.hs --- a/src/Language/PureScript/Bridge/Printer.hs +++ b/src/Language/PureScript/Bridge/Printer.hs @@ -21,6 +21,7 @@ import Language.PureScript.Bridge.SumType import Language.PureScript.Bridge.TypeInfo +import qualified Language.PureScript.Bridge.CodeGenSwitches as Switches data Module (lang :: Language) = PSModule { @@ -39,10 +40,10 @@ type Modules = Map Text PSModule type ImportLines = Map Text ImportLine -printModule :: FilePath -> PSModule -> IO () -printModule root m = do +printModule :: Switches.Settings -> FilePath -> PSModule -> IO () +printModule settings root m = do unlessM (doesDirectoryExist mDir) $ createDirectoryIfMissing True mDir - T.writeFile mPath . moduleToText $ m + T.writeFile mPath . moduleToText settings $ m where mFile = (joinPath . map T.unpack . T.splitOn "." $ psModuleName m) <> ".purs" mPath = root mFile @@ -55,8 +56,8 @@ sumTypeToNeededPackages st = Set.filter (not . T.null) . Set.map _typePackage $ getUsedTypes st -moduleToText :: Module 'PureScript -> Text -moduleToText m = T.unlines $ +moduleToText :: Switches.Settings -> Module 'PureScript -> Text +moduleToText settings m = T.unlines $ "-- File auto generated by purescript-bridge! --" : "module " <> psModuleName m <> " where\n" : map importLineToText allImports @@ -65,9 +66,13 @@ , "import Data.Generic (class Generic)" , "" ] - ++ map sumTypeToText (psTypes m) + ++ map (sumTypeToText settings) (psTypes m) where - otherImports = importsFromList _lensImports + otherImports = + if Switches.generateLenses settings then + importsFromList _lensImports + else + importsFromList _noLensImports allImports = Map.elems $ mergeImportLines otherImports (psImportLines m) _lensImports :: [ImportLine] @@ -80,20 +85,25 @@ , ImportLine "Data.Newtype" $ Set.fromList ["class Newtype"] ] +_noLensImports :: [ImportLine] +_noLensImports = [ + ImportLine "Data.Maybe" $ Set.fromList ["Maybe(..)"] + , ImportLine "Data.Newtype" $ Set.fromList ["class Newtype"] + ] + + importLineToText :: ImportLine -> Text importLineToText l = "import " <> importModule l <> " (" <> typeList <> ")" where typeList = T.intercalate ", " (Set.toList (importTypes l)) -sumTypeToText :: SumType 'PureScript -> Text -sumTypeToText st = - sumTypeToTypeDecls st - <> "\n" - <> sep - <> "\n" - <> sumTypeToOptics st - <> sep +sumTypeToText :: Switches.Settings -> SumType 'PureScript -> Text +sumTypeToText settings st = + sumTypeToTypeDecls 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 diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -13,21 +13,23 @@ import qualified Data.Text as T import Language.PureScript.Bridge import Language.PureScript.Bridge.TypeParameters +import Language.PureScript.Bridge.CodeGenSwitches import Test.Hspec (Spec, describe, hspec, it) import Test.Hspec.Expectations.Pretty import TestData main :: IO () -main = hspec $ allTests +main = hspec allTests allTests :: Spec -allTests = +allTests = do describe "buildBridge" $ do + let settings = defaultSettings it "tests with Int" $ let bst = buildBridge defaultBridge (mkTypeInfo (Proxy :: Proxy Int)) - ti = TypeInfo { _typePackage = "purescript-prim" + ti = TypeInfo { _typePackage = "" , _typeModule = "Prim" , _typeName = "Int" , _typeParameters = []} @@ -40,12 +42,12 @@ [ DataConstructor { _sigConstructor = "Foo" , _sigValues = Left [] } , DataConstructor { _sigConstructor = "Bar" - , _sigValues = Left [ TypeInfo { _typePackage = "purescript-prim" , _typeModule = "Prim" , _typeName = "Int" , _typeParameters = [] } ] + , _sigValues = Left [ TypeInfo { _typePackage = "" , _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 = [] } + , _sigValues = Left [ TypeInfo { _typePackage = "" , _typeModule = "Prim" , _typeName = "Int" , _typeParameters = [] } + , TypeInfo { _typePackage = "" , _typeModule = "Prim" , _typeName = "String" , _typeParameters = [] } ] } ] @@ -54,7 +56,7 @@ it "tests generation of for custom type Foo" $ let prox = Proxy :: Proxy Foo recType = bridgeSumType (buildBridge defaultBridge) (order prox $ mkSumType prox) - recTypeText = sumTypeToText recType + recTypeText = sumTypeToText settings recType txt = T.stripEnd $ T.unlines [ "data Foo =" , " Foo" @@ -90,7 +92,7 @@ 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 . Map.elems $ modules + m = head . map (moduleToText settings) . Map.elems $ modules txt = T.unlines [ "-- File auto generated by purescript-bridge! --" , "module TestData where" , "" @@ -209,7 +211,7 @@ in (barOptics <> recTypeOptics) `shouldBe` txt it "tests generation of newtypes for record data type" $ let recType = bridgeSumType (buildBridge defaultBridge) (mkSumType (Proxy :: Proxy (SingleRecord A B))) - recTypeText = sumTypeToText recType + recTypeText = sumTypeToText settings recType txt = T.stripEnd $ T.unlines [ "newtype SingleRecord a b =" , " SingleRecord {" @@ -236,7 +238,7 @@ in recTypeText `shouldBe` txt it "tests generation of newtypes for haskell newtype" $ let recType = bridgeSumType (buildBridge defaultBridge) (mkSumType (Proxy :: Proxy SomeNewtype)) - recTypeText = sumTypeToText recType + recTypeText = sumTypeToText settings recType txt = T.stripEnd $ T.unlines [ "newtype SomeNewtype =" , " SomeNewtype Int" @@ -252,7 +254,7 @@ 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 recType + recTypeText = sumTypeToText settings recType txt = T.stripEnd $ T.unlines [ "newtype SingleValueConstr =" , " SingleValueConstr Int" @@ -268,7 +270,7 @@ 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 recType + recTypeText = sumTypeToText settings recType txt = T.stripEnd $ T.unlines [ "data SingleProduct =" , " SingleProduct String Int" @@ -288,3 +290,90 @@ let recType = bridgeSumType (buildBridge defaultBridge) (mkSumType (Proxy :: Proxy TwoRecords)) recTypeOptics = recordOptics recType in recTypeOptics `shouldBe` "" -- No record optics for multi-constructors + + describe "buildBridge without lens-code-gen" $ do + let settings = getSettings noLenses + 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.Maybe (Maybe, Maybe(..))" + , "import Data.Newtype (class Newtype)" + , "" + , "import Prelude" + , "import Data.Generic (class Generic)" + , "" + , "data Bar a b m c =" + , " Bar1 (Maybe a)" + , " | Bar2 (Either a b)" + , " | Bar3 a" + , " | Bar4 {" + , " myMonadicResult :: m b" + , " }" + , "" + , "derive instance genericBar :: (Generic a, Generic b, Generic (m b)) => 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, Generic b) => 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 +