purescript-bridge 0.12.0.0 → 0.13.0.0

raw patch · 7 files changed

+215/−45 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• purescript-bridge.cabal +2/−1
• src/Language/PureScript/Bridge.hs +34/−11
• src/Language/PureScript/Bridge/Builder.hs +1/−1
• src/Language/PureScript/Bridge/CodeGenSwitches.hs +47/−0
• src/Language/PureScript/Bridge/PSTypes.hs +5/−5
• src/Language/PureScript/Bridge/Printer.hs +25/−15
• test/Spec.hs +101/−12

@@ -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

@@ -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. --

@@ -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   } 

@@ -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 }

@@ -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 = []

@@ -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

@@ -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+