purescript-bridge 0.7.0.1 → 0.8.0.0
raw patch · 6 files changed
+50/−33 lines, 6 filesdep ~base
Dependency ranges changed: base
Files
- README.md +1/−3
- purescript-bridge.cabal +2/−2
- src/Language/PureScript/Bridge/Printer.hs +19/−9
- src/Language/PureScript/Bridge/SumType.hs +17/−9
- test/Spec.hs +6/−5
- test/TestData.hs +5/−5
README.md view
@@ -24,6 +24,4 @@ ## Status -This library is at a quite early stage. It works for my use case at the moment and I will fix bugs when they come along. Also PRs for more `PSType`s definitions and bridges are very welcome!--Expect bugs - especially for more advanced use cases. Although I have tested the most advanced one already with no issues, bugs always creep in.+It works for my use case and is used in production. PRs for more `PSType`s definitions and bridges are very welcome!
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.1+version: 0.8.0.0 -- 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 && <= 5.1+ build-depends: base >=4.8 && < 6.0 , containers , directory , filepath
src/Language/PureScript/Bridge/Printer.hs view
@@ -50,11 +50,8 @@ sumTypesToNeededPackages = Set.unions . map sumTypeToNeededPackages sumTypeToNeededPackages :: SumType lang -> Set Text-sumTypeToNeededPackages st = let- types = getUsedTypes st- packages = filter (not . T.null) . map _typePackage $ types- in- Set.fromList packages+sumTypeToNeededPackages st =+ Set.filter (not . T.null) . Set.map _typePackage $ getUsedTypes st moduleToText :: Module 'PureScript -> Text moduleToText m = T.unlines $@@ -71,10 +68,23 @@ typeList = T.intercalate ", " (Set.toList (importTypes l)) sumTypeToText :: SumType 'PureScript -> Text-sumTypeToText (SumType t cs) = T.unlines $+sumTypeToText st@(SumType t cs) = T.unlines $ "data " <> typeInfoToText True t <> " =" : " " <> T.intercalate "\n | " (map (constructorToText 4) cs)- : [ "\nderive instance generic" <> _typeName t <> " :: Generic " <> _typeName t ]+ : [ "\nderive instance generic" <> _typeName t <> " :: " <> genericConstrains <> genericInstance t ]+ where+ genericInstance = ("Generic " <>) . typeInfoToText False+ genericConstrains+ | stpLength == 0 = mempty+ | otherwise = (<> " => ") $+ if stpLength == 1+ then genericConstrainsInner+ else bracketWrap genericConstrainsInner+ genericConstrainsInner = T.intercalate ", " $ map genericInstance sumTypeParameters+ stpLength = length sumTypeParameters+ bracketWrap x = "(" <> x <> ")"+ sumTypeParameters = filter isTypeParam . Set.toList $ getUsedTypes st+ isTypeParam typ = _typeName typ `elem` map _typeName (_typeParameters t) constructorToText :: Int -> DataConstructor 'PureScript -> Text@@ -120,11 +130,11 @@ } dropSelf = Map.delete (_typeModule t) -typesToImportLines :: ImportLines -> [PSType] -> ImportLines+typesToImportLines :: ImportLines -> Set PSType -> ImportLines typesToImportLines = foldr typeToImportLines typeToImportLines :: PSType -> ImportLines -> ImportLines-typeToImportLines t ls = typesToImportLines (update ls) (_typeParameters t)+typeToImportLines t ls = typesToImportLines (update ls) (Set.fromList (_typeParameters t)) where update = if not (T.null (_typeModule t)) then Map.alter (Just . updateLine) (_typeModule t)
src/Language/PureScript/Bridge/SumType.hs view
@@ -15,7 +15,7 @@ , DataConstructor (..) , RecordEntry (..) , getUsedTypes-, constructorToType+, constructorToTypes , sigConstructor , sigValues , sumTypeInfo@@ -24,10 +24,12 @@ , recValue ) where -import Control.Lens hiding (from, to)+import Control.Lens hiding (from, to) import Data.Proxy-import Data.Text (Text)-import qualified Data.Text as T+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Text (Text)+import qualified Data.Text as T import Data.Typeable import Generics.Deriving @@ -102,12 +104,18 @@ } ] -getUsedTypes :: SumType lang -> [TypeInfo lang]-getUsedTypes (SumType _ cs) = foldr constructorToType [] cs+-- | Get all used types in a sum type.+--+-- This includes all types found at the right hand side of a sum type+-- definition, not the type parameters of the sum type itself+getUsedTypes :: SumType lang -> Set (TypeInfo lang)+getUsedTypes (SumType _ cs) = foldr constructorToTypes Set.empty cs -constructorToType :: DataConstructor lang -> [TypeInfo lang] -> [TypeInfo lang]-constructorToType (DataConstructor _ (Left myTs)) ts = concatMap flattenTypeInfo myTs ++ ts-constructorToType (DataConstructor _ (Right rs)) ts = concatMap (flattenTypeInfo . _recValue) rs ++ ts+constructorToTypes :: DataConstructor lang -> Set (TypeInfo lang) -> Set (TypeInfo lang)+constructorToTypes (DataConstructor _ (Left myTs)) ts =+ Set.fromList (concatMap flattenTypeInfo myTs) `Set.union` ts+constructorToTypes (DataConstructor _ (Right rs)) ts =+ Set.fromList (concatMap (flattenTypeInfo . _recValue) rs) `Set.union` ts -- Lenses: makeLenses ''DataConstructor
test/Spec.hs view
@@ -1,10 +1,10 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE CPP #-} module Main where @@ -14,7 +14,8 @@ import qualified Data.Text as T import Language.PureScript.Bridge import Language.PureScript.Bridge.TypeParameters-import Test.Hspec (Spec, hspec, describe, it)+import Test.Hspec (Spec, describe,+ hspec, it) import Test.Hspec.Expectations.Pretty import TestData@@ -53,7 +54,7 @@ ] 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)))+ 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 txt = T.unlines [ "-- File auto generated by purescript-bridge! --"@@ -65,7 +66,7 @@ , "import Data.Generic (class Generic)" , "" , ""- , "data Bar a b m ="+ , "data Bar a b m c =" , " Bar1 (Maybe a)" , " | Bar2 (Either a b)" , " | Bar3 a"@@ -73,7 +74,7 @@ , " myMonadicResult :: m b" , " }" , ""- , "derive instance genericBar :: Generic Bar"+ , "derive instance genericBar :: (Generic a, Generic b, Generic (m b)) => Generic (Bar a b m c)" , "" ] in m `shouldBe` txt
test/TestData.hs view
@@ -10,9 +10,9 @@ module TestData where import Data.Proxy-import Data.Text (Text)+import Data.Text (Text) import Data.Typeable-import GHC.Generics (Generic)+import GHC.Generics (Generic) import Language.PureScript.Bridge import Language.PureScript.Bridge.PSTypes @@ -40,9 +40,9 @@ | 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)+data Bar a b m c = Bar1 (Maybe a) | Bar2 (Either a b) | Bar3 a+ | Bar4 { myMonadicResult :: m b }+ deriving (Generic, Typeable, Show) a :: HaskellType