diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,9 +1,14 @@ # purescript-bridge + +[![Build Status](https://travis-ci.org/eskimor/purescript-bridge.svg?branch=master)](https://travis-ci.org/eskimor/purescript-bridge) + + + Translate your Haskell types to PureScript types. It should in theory work for almost all Haskell types, including type constructors! -You just have to instantiate it with dummy parameters from e.g. "Language.PureScript.Bridge.TypeParameters". +You just have to instantiate it with dummy parameters from e.g. "Language.PureScript.Bridge.TypeParameters". -Data type translation is fully and easily customizable by providing your own `TypeBridge` instances! +Data type translation is fully and easily customizable by providing your own `BridgePart` instances! ## JSON encoding / decoding @@ -16,7 +21,7 @@ [here](https://github.com/purescript-contrib/purescript-argonaut-codecs/pull/12). -## Documentation +## Documentation Usage of this library is documented in [`Language.Purescript.Bridge`](http://hackage.haskell.org/package/purescript-bridge/docs/Language-PureScript-Bridge.html). @@ -24,6 +29,6 @@ ## 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 PureScript `TypeInfo` definitions and bridges are very welcome! +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. 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.4.0.0 +version: 0.6.0.0 -- A short (one-line) description of the package. synopsis: Generate PureScript data types from Haskell data types 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 @@ -33,7 +33,7 @@ -- > , mkSumType (Proxy :: Proxy MyType2) -- > ] -- > --- > writePSTypes (buildBridge defaultBridge) "path/to/your/purescript/project" myTypes +-- > writePSTypes "path/to/your/purescript/project" (buildBridge defaultBridge) myTypes -- -- You can define your own type bridges based on 'defaultBridge': -- @@ -42,7 +42,7 @@ -- -- and use it with 'writePSTypes': -- --- > writePSTypes (buildBridge myBridge) "path/to/your/purescript/project" myTypes +-- > writePSTypes "path/to/your/purescript/project" (buildBridge myBridge) myTypes -- -- Find examples for implementing your own bridges in: "Language.PureScript.Bridge.Primitives". -- @@ -67,8 +67,8 @@ -- -- == /WARNING/: -- This function overwrites files - make backups or use version control! -writePSTypes :: FullBridge -> FilePath -> [SumType 'Haskell] -> IO () -writePSTypes br root sts = do +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 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 @@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -8,30 +9,30 @@ -- | A bridge builder DSL, powered by 'Monad', 'Alternative' and lens. -- --- Bridges can be built within the BridgeBuilder monad. --- You can check properties of the to be bridged Haskell 'TypeInfo' with '^==' or 'doCheck', --- you have choice ('<|>'), you can fail ('empty') and you can return a translated PureScript --- 'TypeInfo' ('return'). The Haskell 'TypeInfo' can be accessed with: +-- Bridges can be built within the 'BridgeBuilder' monad. +-- You can check properties of the to-be-bridged 'HaskellType' with '^==' or 'doCheck', +-- you have choice ('<|>'), you can fail ('empty') and you can return a translated +-- 'PSType' ('return'). The 'HaskellType' can be accessed with: -- -- > view haskType -- -- Find usage examples in "Language.PureScript.Bridge.Primitives" and "Language.PureScript.Bridge.PSTypes" module Language.PureScript.Bridge.Builder ( - FullBridge + BridgeBuilder +, BridgePart +, FixUpBuilder , FixUpBridge , BridgeData , fullBridge -, BridgeBuilder -, BridgePart -, clearPackageFixUp -, errorFixUp -, buildBridge -, buildBridgeWithCustomFixUp -, doCheck , (^==) +, doCheck , (<|>) , psTypeParameters -, fixTypeParameters +, FullBridge +, buildBridge +, clearPackageFixUp +, errorFixUp +, buildBridgeWithCustomFixUp ) where import Control.Applicative @@ -39,49 +40,80 @@ import Control.Monad (MonadPlus, guard, mplus, mzero) import Control.Monad.Reader.Class -import Control.Monad.Trans.Reader (ReaderT (..)) +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 -type FullBridge = TypeInfo 'Haskell -> TypeInfo 'PureScript +newtype BridgeBuilder a = + BridgeBuilder (ReaderT BridgeData Maybe a) + deriving (Functor, Applicative, Monad, MonadReader BridgeData) --- | Bridges to use when a 'BridgePart' returns 'Nothing'. -type FixUpBridge = FullBridge +type BridgePart = BridgeBuilder PSType +-- | Bridges to use when a 'BridgePart' returns 'Nothing' (See 'buildBridgeWithCustomFixUp'). +-- +-- It is similar to BridgeBuilder but does not offer choice or failure. It is used for constructing fallbacks +-- if a 'BridgePart' evaluates to 'Nothing'. +-- +-- For type definitions you should use the more generic ('MonadReader' 'BridgeData' m) constraint. This way your code will work +-- in both 'FixUpBuilder' and 'BridgeBuilder': +-- +-- > {-# LANGUAGE FlexibleContexts #-} +-- > +-- > import Control.Monad.Reader.Class +-- > import Language.PureScript.Bridge.TypeInfo + +-- > +-- > psEither :: MonadReader BridgeData m => m PSType +-- > psEither = .... +-- +-- instead of: +-- +-- > psEither :: BridgePart +-- > psEither = .... +-- +-- or +-- +-- > psEither :: FixUpBridge +-- > psEither = .... +-- +newtype FixUpBuilder a = FixUpBuilder (Reader BridgeData a) deriving (Functor, Applicative, Monad, MonadReader BridgeData) + +type FixUpBridge = FixUpBuilder PSType + +type FullBridge = HaskellType -> PSType + data BridgeData = BridgeData { -- | The Haskell type to translate. - _haskType :: TypeInfo 'Haskell + _haskType :: HaskellType -- | Reference to the bride itself, needed for translation of type constructors. , _fullBridge :: FullBridge } -- | By implementing the 'haskType' lens in the HasHaskType class, we are able --- to use it for both 'BridgeData' and a plain 'TypeInfo Haskell', therefore --- you can use it with 'doCheck' and '^==' for checks on the complete 'TypeInfo Haskell' +-- to use it for both 'BridgeData' and a plain 'HaskellType', therefore +-- you can use it with 'doCheck' and '^==' for checks on the complete 'HaskellType' -- value. -- -- Example: -- -- > stringBridge :: BridgePart -- > stringBridge = do --- > -- Note: we are using the TypeInfo 'Haskell instance here: +-- > -- Note: we are using the HaskellType instance here: -- > haskType ^== mkTypeInfo (Proxy :: Proxy String) -- > return psString instance HasHaskType BridgeData where haskType inj (BridgeData iT fB) = flip BridgeData fB <$> inj iT +-- | Lens for access to the complete bridge from within our Reader monad. +-- +-- This is used for example for implementing 'psTypeParameters'. fullBridge :: Lens' BridgeData FullBridge fullBridge inj (BridgeData iT fB) = BridgeData iT <$> inj fB -newtype BridgeBuilder a = - BridgeBuilder (ReaderT BridgeData Maybe a) - deriving (Functor, Applicative, Monad, MonadReader BridgeData) - - -type BridgePart = BridgeBuilder (TypeInfo 'PureScript) - -- | Bridge to PureScript by simply clearing out the '_typePackage' field. -- This bridge is used by default as 'FixUpBridge' by 'buildBridge': -- @@ -96,14 +128,10 @@ -- -- > buildBridgeWithCustomFixUp errorFixUp yourBridge -- --- Of course you can also write your own 'FixUpBridge'. --- In this case it is highly recommended that you build your custom 'FixUpBridge' --- from 'BridgePart' with 'buildBridgeWithCustomFixUp' too, with 'FixUpBridge' being finally 'errorFixUp'. --- This way you get all the builder convenience and proper bridging of 'typeParameters'. --- For an example have a look at the implementation --- of 'clearPackageFixup'. -clearPackageFixUp :: FixUpBridge -clearPackageFixUp = buildBridgeWithCustomFixUp errorFixUp $ do +-- Of course you can also write your own 'FixUpBridge'. It works the same +-- as for 'BridgePart', but you can not have choice ('<|>') or failure ('empty'). +clearPackageFixUp :: MonadReader BridgeData m => m PSType +clearPackageFixUp = do input <- view haskType psArgs <- psTypeParameters return TypeInfo { @@ -117,18 +145,18 @@ -- Usage: -- -- > buildBridgeWithCustomFixUp errorFixUp yourBridge -errorFixUp :: FixUpBridge -errorFixUp inType = let - message = "No translation supplied for Haskell type: '" - <> inType ^. typeName <> "', from module: '" - <> inType ^. typeModule <> "', from package: '" - <> inType ^. typePackage <> "'!" - in - error $ T.unpack message +errorFixUp :: MonadReader BridgeData m => m PSType +errorFixUp = do + inType <- view haskType + let message = "No translation supplied for Haskell type: '" + <> inType ^. typeName <> "', from module: '" + <> inType ^. typeModule <> "', from package: '" + <> inType ^. typePackage <> "'!" + return $ error $ T.unpack message -- | Build a bridge. -- --- This is a convenience wrapper for 'buildBridgeWithCustomFixUp'. +-- This is a convenience wrapper for 'buildBridgeWithCustomFixUp' and should normally be sufficient. -- -- Definition: -- @@ -139,15 +167,12 @@ -- | Takes a constructed BridgePart and makes it a total function ('FullBridge') -- by using the supplied 'FixUpBridge' when 'BridgePart' returns 'Nothing'. --- --- The supplied 'BridgePart' also gets passed through 'fixTypeParameters' in --- order to support translation of type constructors. buildBridgeWithCustomFixUp :: FixUpBridge -> BridgePart -> FullBridge -buildBridgeWithCustomFixUp fixUp rawPart = let - (BridgeBuilder bridgePart) = fixTypeParameters rawPart - mayBridge :: TypeInfo 'Haskell -> Maybe (TypeInfo 'PureScript) +buildBridgeWithCustomFixUp (FixUpBuilder fixUp) (BridgeBuilder bridgePart) = let + mayBridge :: HaskellType -> Maybe PSType mayBridge inType = runReaderT bridgePart $ BridgeData inType bridge - bridge inType = fromMaybe (fixUp inType) (mayBridge inType) + fixBridge inType = runReader fixUp $ BridgeData inType bridge + bridge inType = fixTypeParameters $ fromMaybe (fixBridge inType) (mayBridge inType) in bridge @@ -158,17 +183,15 @@ -- This method gets called by 'buildBridge' and buildBridgeWithCustomFixUp for you - you should not need to call it. -- -- It enables you to even bridge type constructor definitions, see "Language.PureScript.Bridge.TypeParameters" for more details. -fixTypeParameters :: BridgePart -> BridgePart -fixTypeParameters br = (needsFix >> fixIt) <|> br - where - needsFix = doCheck typeModule ("TypeParameters" `T.isSuffixOf`) - fixIt = do - r <- br - return r { +fixTypeParameters :: TypeInfo lang -> TypeInfo lang +fixTypeParameters t = if "TypeParameters" `T.isSuffixOf` _typeModule t + then t { _typePackage = "" -- Don't suggest any packages , _typeModule = "" -- Don't import any modules - , _typeName = r ^. typeName . to (stripNum . T.toLower) + , _typeName = t ^. typeName . to (stripNum . T.toLower) } + else t + where stripNum v = fromMaybe v (T.stripSuffix "1" v) @@ -189,7 +212,7 @@ mplus = (<|>) -- | Do some check on properties of 'haskType'. -doCheck :: Getter (TypeInfo 'Haskell) a -> (a -> Bool) -> BridgeBuilder () +doCheck :: Getter HaskellType a -> (a -> Bool) -> BridgeBuilder () doCheck l check = guard =<< views (haskType . l) check -- | Check parts of 'haskType' for equality: @@ -199,7 +222,7 @@ -- > typeName ^== "Text" -- > typeModule ^== "Data.Text.Internal" <|> typeModule ^== "Data.Text.Internal.Lazy" -- > return psString -(^==) :: Eq a => Getter (TypeInfo 'Haskell) a -> a -> BridgeBuilder () +(^==) :: Eq a => Getter HaskellType a -> a -> BridgeBuilder () l ^== a = doCheck l (== a) infix 4 ^== @@ -207,5 +230,5 @@ -- | Bridge 'haskType' 'typeParameters' over to PureScript types. -- -- To be used for bridging type constructors. -psTypeParameters :: BridgeBuilder [TypeInfo 'PureScript] +psTypeParameters :: MonadReader BridgeData m => m [PSType] psTypeParameters = map <$> view fullBridge <*> view (haskType . typeParameters) 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 @@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeSynonymInstances #-} @@ -9,15 +10,17 @@ import Control.Lens (views) import Data.Monoid import qualified Data.Text as T +import Control.Monad.Reader.Class + import Language.PureScript.Bridge.Builder import Language.PureScript.Bridge.TypeInfo -- | Uses type parameters from 'haskType' (bridged). -psArray :: BridgePart +psArray :: MonadReader BridgeData m => m PSType psArray = TypeInfo "purescript-prim" "Prim" "Array" <$> psTypeParameters -psBool :: TypeInfo 'PureScript +psBool :: PSType psBool = TypeInfo { _typePackage = "purescript-prim" , _typeModule = "Prim" @@ -26,10 +29,10 @@ } -- | Uses type parameters from 'haskType' (bridged). -psEither :: BridgePart +psEither :: MonadReader BridgeData m => m PSType psEither = TypeInfo "purescript-either" "Data.Either" "Either" <$> psTypeParameters -psInt :: TypeInfo 'PureScript +psInt :: PSType psInt = TypeInfo { _typePackage = "purescript-prim" , _typeModule = "Prim" @@ -38,10 +41,10 @@ } -- | Uses type parameters from 'haskType' (bridged). -psMaybe :: BridgePart +psMaybe :: MonadReader BridgeData m => m PSType psMaybe = TypeInfo "purescript-maybe" "Data.Maybe" "Maybe" <$> psTypeParameters -psString :: TypeInfo 'PureScript +psString :: PSType psString = TypeInfo { _typePackage = "purescript-prim" , _typeModule = "Prim" @@ -50,7 +53,7 @@ } -- | Uses type parameters from 'haskType' (bridged). -psTuple :: BridgePart +psTuple :: MonadReader BridgeData m => m PSType psTuple = do size <- views (haskType . typeParameters) length let @@ -58,7 +61,7 @@ tupleName = "Tuple" <> if size == 2 then "" else T.pack (show size) TypeInfo "purescript-tuples" tupleModule tupleName <$> psTypeParameters -psUnit :: TypeInfo 'PureScript +psUnit :: PSType psUnit = TypeInfo { _typePackage = "purescript-prelude" , _typeModule = "Prelude" diff --git a/src/Language/PureScript/Bridge/Primitives.hs b/src/Language/PureScript/Bridge/Primitives.hs --- a/src/Language/PureScript/Bridge/Primitives.hs +++ b/src/Language/PureScript/Bridge/Primitives.hs @@ -1,4 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DataKinds #-} + + module Language.PureScript.Bridge.Primitives where @@ -6,12 +10,18 @@ import Language.PureScript.Bridge.Builder import Language.PureScript.Bridge.PSTypes import Language.PureScript.Bridge.TypeInfo +import Control.Monad.Reader.Class + boolBridge :: BridgePart boolBridge = typeName ^== "Bool" >> return psBool eitherBridge :: BridgePart eitherBridge = typeName ^== "Either" >> psEither + +-- | Dummy bridge, translates every type with 'clearPackageFixUp' +dummyBridge :: MonadReader BridgeData m => m PSType +dummyBridge = clearPackageFixUp intBridge :: BridgePart intBridge = typeName ^== "Int" >> return psInt 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 @@ -91,7 +91,7 @@ recordEntryToText e = _recLabel e <> " :: " <> typeInfoToText True (_recValue e) -typeInfoToText :: Bool -> TypeInfo 'PureScript -> Text +typeInfoToText :: Bool -> PSType -> Text typeInfoToText topLevel t = if needParens then "(" <> inner <> ")" else inner where inner = _typeName t <> @@ -120,10 +120,10 @@ } dropSelf = Map.delete (_typeModule t) -typesToImportLines :: ImportLines -> [TypeInfo 'PureScript] -> ImportLines +typesToImportLines :: ImportLines -> [PSType] -> ImportLines typesToImportLines = foldr typeToImportLines -typeToImportLines :: TypeInfo 'PureScript -> ImportLines -> ImportLines +typeToImportLines :: PSType -> ImportLines -> ImportLines typeToImportLines t = if not (T.null (_typeModule t)) then Map.alter (Just . updateLine) (_typeModule t) else id diff --git a/src/Language/PureScript/Bridge/Tuple.hs b/src/Language/PureScript/Bridge/Tuple.hs --- a/src/Language/PureScript/Bridge/Tuple.hs +++ b/src/Language/PureScript/Bridge/Tuple.hs @@ -5,6 +5,7 @@ import qualified Data.Text as T + import Language.PureScript.Bridge.Builder import Language.PureScript.Bridge.PSTypes (psTuple) import Language.PureScript.Bridge.TypeInfo @@ -28,5 +29,5 @@ step Tuple _ = NoTuple step NoTuple _ = NoTuple -isTuple :: TypeInfo 'Haskell -> Bool +isTuple :: HaskellType -> Bool isTuple = (== Tuple) . T.foldl' step Start . _typeName diff --git a/src/Language/PureScript/Bridge/TypeInfo.hs b/src/Language/PureScript/Bridge/TypeInfo.hs --- a/src/Language/PureScript/Bridge/TypeInfo.hs +++ b/src/Language/PureScript/Bridge/TypeInfo.hs @@ -9,6 +9,8 @@ module Language.PureScript.Bridge.TypeInfo ( TypeInfo (..) + , PSType + , HaskellType , mkTypeInfo , mkTypeInfo' , Language (..) @@ -42,19 +44,26 @@ makeLenses ''TypeInfo +-- | For convenience: +type PSType = TypeInfo 'PureScript + +-- | For convenience: +type HaskellType = TypeInfo 'Haskell + + -- | Types that have a lens for accessing a 'TypeInfo Haskell'. class HasHaskType t where - haskType :: Lens' t (TypeInfo 'Haskell) + haskType :: Lens' t HaskellType -- | Simple 'id' instance: Get the 'TypeInfo' itself. -instance HasHaskType (TypeInfo 'Haskell) where +instance HasHaskType HaskellType where haskType inj = inj -mkTypeInfo :: Typeable t => Proxy t -> TypeInfo 'Haskell +mkTypeInfo :: Typeable t => Proxy t -> HaskellType mkTypeInfo = mkTypeInfo' . typeRep -mkTypeInfo' :: TypeRep -> TypeInfo 'Haskell +mkTypeInfo' :: TypeRep -> HaskellType mkTypeInfo' rep = let con = typeRepTyCon rep in TypeInfo {