packages feed

purescript-bridge 0.1.0.0 → 0.3.0.0

raw patch · 16 files changed

+525/−393 lines, 16 filesdep +directory

Dependencies added: directory

Files

− dist/build/testsStub/testsStub-tmp/testsStub.hs 
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import Tests ( tests )-main :: IO ()-main = stubMain tests
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.1.0.0+version:             0.3.0.0  -- A short (one-line) description of the package. synopsis:            Generate PureScript data types from Haskell data types@@ -51,12 +51,13 @@  library   -- Modules exported by the library.-  exposed-modules: PureScript.Bridge.SumType-                , PureScript.Bridge.TypeInfo-                , PureScript.Bridge.Tuple-                , PureScript.Bridge.Primitives-                , PureScript.Bridge-                , PureScript.Bridge.Printer+  exposed-modules: Language.PureScript.Bridge.SumType+                , Language.PureScript.Bridge.TypeInfo+                , Language.PureScript.Bridge.Tuple+                , Language.PureScript.Bridge.Primitives+                , Language.PureScript.Bridge+                , Language.PureScript.Bridge.Printer+                , Language.PureScript.Bridge.TypeParameters    -- Modules included in this library but not exported.   -- other-modules:@@ -67,6 +68,7 @@   -- Other library packages from which modules are imported.   build-depends:       base >=4.8 && <4.9                      , containers+                     , directory                      , filepath                      , text                      , generic-deriving@@ -82,7 +84,8 @@ Test-Suite tests     type:       detailed-0.9     test-module: Tests-    build-depends: base, Cabal >= 1.9.2+    build-depends: base+                , Cabal >= 1.9.2                 , HUnit                 , purescript-bridge     hs-source-dirs: test
+ src/Language/PureScript/Bridge.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE OverloadedStrings #-}+module Language.PureScript.Bridge (+    bridgeSumType+  , defaultBridge+  , module Bridge+  , writePSTypes+ ) where+++import qualified Data.Text as T++import Language.PureScript.Bridge.SumType as Bridge+import Language.PureScript.Bridge.TypeInfo as Bridge+import Language.PureScript.Bridge.Tuple as Bridge+import Language.PureScript.Bridge.Primitives as Bridge+import Language.PureScript.Bridge.Printer as Bridge++++import Control.Applicative+import qualified Data.Map as M+import Data.Maybe++-- | Your entry point to this library and quite likely all you will need.+-- | Make sure all your types derive Generic and Typeable.+-- | Typeable is not needed from ghc-7.10 on.+-- | Then call 'writePSTypes' like this:+-- | @+-- |   let myTypes = [+-- |        'toSumType' ('Proxy' :: 'Proxy' MyType1)+-- |      , 'toSumType' ('Proxy' :: 'Proxy' MyType2)+-- |     ]+-- |   'writePSTypes' 'defaultBridge' "path/to/you/purescript/project" myTypes+-- | @+-- | You can add new type mappings, like this:+-- | @+-- |   myBridge = 'defaultBridge' <|> mySpecialTypeBridge+-- | @+-- | Find examples for implementing your own type bridges in: 'Language.PureScript.Bridge.Primitives'+-- | A real world use case of this library can be found <https://github.com/gonimo/gonimo-back/blob/master/src/MkFrontendTypes.hs here>.+-- | Last but not least:+-- | WARNING: This function overwrites files - make backups or use version control!+writePSTypes :: TypeBridge -> FilePath -> [SumType] -> IO ()+writePSTypes br root sts = do+    let bridged = map (bridgeSumType br) sts+    let modules = M.elems $ sumTypesToModules M.empty bridged+    mapM_ (printModule root) modules++bridgeSumType :: TypeBridge -> SumType -> SumType+bridgeSumType br (SumType t cs) = SumType t $ map (bridgeConstructor br) cs++{--+ -- Optimistically and recursively translate types: If the passed TypeBridge returns Nothing,+ -- then the original TypeInfo is returned with the typePackage field cleared.+ -- You don't need to call this function directly, just use bridgeSumType with your TypeBridge+--}+doBridge :: TypeBridge -> TypeInfo -> TypeInfo+doBridge br info = let+    translated = info { typePackage = "" }+    res = fixTypeParameters $ fromMaybe translated (br info)+  in+    res {+      typeParameters = map (doBridge br) . typeParameters $ res+    }++-- | Default bridge for mapping primitive/common types:+-- | You can append your own bridges like this:+-- | defaultBridge <|> myBridge1 <|> myBridge2+defaultBridge :: TypeBridge+defaultBridge t = stringBridge t+  <|> listBridge t+  <|> maybeBridge t+  <|> eitherBridge t+  <|> boolBridge t+  <|> intBridge t+  <|> tupleBridge t++bridgeConstructor :: TypeBridge -> DataConstructor -> DataConstructor+bridgeConstructor br (DataConstructor name (Left infos)) =+    DataConstructor name . Left $ map (doBridge br) infos+bridgeConstructor br (DataConstructor name (Right record)) =+    DataConstructor name . Right $ map (bridgeRecordEntry br) record++bridgeRecordEntry :: TypeBridge -> RecordEntry -> RecordEntry+bridgeRecordEntry br (RecordEntry label value) = RecordEntry label $ doBridge br value++-- | Translate types that come from any module named "Something.TypeParameters" to lower case:+-- | Also drop the 1 at the end if present+fixTypeParameters :: TypeInfo -> TypeInfo+fixTypeParameters t+  | T.isSuffixOf "TypeParameters" (typeModule t) = t {+      typePackage = "" -- Don't suggest any packages+    , typeModule = "" -- Don't import any modules+    , typeName = stripNum . T.toLower $ typeName t+    }+  | otherwise = t+  where+    stripNum v = fromMaybe v (T.stripSuffix "1" v)
+ src/Language/PureScript/Bridge/Primitives.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE OverloadedStrings #-}+module Language.PureScript.Bridge.Primitives where+++import Language.PureScript.Bridge.TypeInfo++boolBridge :: TypeBridge+boolBridge t+  | eqTypeName "Bool" t = Just $ t {+      typePackage = "purescript-prim"+    , typeModule = "Prim"+    , typeName = "Boolean"+    , typeParameters = []+    }+  | otherwise = Nothing++intBridge :: TypeBridge+intBridge t+  | eqTypeName "Int" t = Just $ t {+      typePackage = "purescript-prim"+    , typeModule = "Prim"+    }+  | otherwise = Nothing+++stringBridge :: TypeBridge+stringBridge t+  | isStringLike = Just $ t {+      typePackage = "purescript-prim"+    , typeModule = "Prim"+    , typeName = "String"+    , typeParameters = []+    }+  | otherwise = Nothing+  where+    isStringLike = isText || isString+    isText = typeName t == "Text"+    isString = typeName t == "[]" && all ((==) "Char" . typeName) (typeParameters t)++listBridge :: TypeBridge+listBridge t+  | eqTypeName "[]" t = Just $ t {+      typePackage = "purescript-prim"+    , typeModule = "Prim"+    , typeName = "Array"+    }+  | otherwise = Nothing++maybeBridge :: TypeBridge+maybeBridge t+  | eqTypeName "Maybe" t = Just $ t {+      typePackage = "purescript-maybe"+    , typeModule = "Data.Maybe"+    }+  | otherwise = Nothing+++eitherBridge :: TypeBridge+eitherBridge t+  | eqTypeName "Either" t = Just $ t {+      typePackage = "purescript-either"+    , typeModule = "Data.Either"+    }+  | otherwise = Nothing
+ src/Language/PureScript/Bridge/Printer.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE OverloadedStrings #-}+module Language.PureScript.Bridge.Printer where++import Data.Map.Strict (Map)+import qualified Data.Map.Strict as M+import Data.Monoid+import Data.Set (Set)+import qualified Data.Set as S+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import System.Directory+import System.FilePath+import Control.Monad+++import Language.PureScript.Bridge.SumType+import Language.PureScript.Bridge.TypeInfo+++data PSModule = PSModule {+  psModuleName :: !Text+, psImportLines :: !(Map Text ImportLine)+, psTypes :: ![SumType]+} deriving Show++data ImportLine = ImportLine {+  importModule :: !Text+, importTypes :: !(Set Text)+} deriving Show++type Modules = Map Text PSModule+type ImportLines = Map Text ImportLine++printModule :: FilePath -> PSModule -> IO ()+printModule root m = do+  unlessM (doesDirectoryExist mDir) $ createDirectoryIfMissing True mDir+  T.writeFile mPath . moduleToText $ m+  where+    mFile = (joinPath . map T.unpack . T.splitOn "." $ psModuleName m) <> ".purs"+    mPath = root </> mFile+    mDir = takeDirectory mPath++moduleToText :: PSModule -> Text+moduleToText m = T.unlines $+  "module " <> psModuleName m <> " where\n"+  : map importLineToText (M.elems (psImportLines m))+  ++ [ "\nimport Data.Generic (class Generic)\n\n" ]+  ++ map sumTypeToText (psTypes m)+++importLineToText :: ImportLine -> Text+importLineToText l = "import " <> importModule l <> " (" <> typeList <> ")"+  where+    typeList = T.intercalate ", " (S.toList (importTypes l))++sumTypeToText :: SumType -> Text+sumTypeToText (SumType t cs) = T.unlines $+    "data " <> typeName t <> " ="+  :  [ "    " <> T.intercalate "\n  | " (map (constructorToText 4) cs) ]+  ++ [ "\nderive instance generic" <> typeName t <> " :: Generic " <> typeName t <> "\n" ]+++constructorToText :: Int -> DataConstructor -> Text+constructorToText _ (DataConstructor n (Left ts))  = n <> " " <> T.intercalate " " (map typeInfoToText ts)+constructorToText indentation (DataConstructor n (Right rs)) = T.unlines $+      n <> " {"+    :  [ spaces (indentation + 2) <> T.intercalate intercalation (map recordEntryToText rs) ]+    ++ [ spaces indentation <> "}" ]+  where+    intercalation = "\n" <> spaces indentation <> "," <> " "+    spaces c = T.replicate c " "++recordEntryToText :: RecordEntry -> Text+recordEntryToText e = recLabel e <> " :: " <> typeInfoToText (recValue e)+++typeInfoToText :: TypeInfo -> Text+typeInfoToText t = if length textParameters > 1 then "(" <> inner <> ")" else inner+  where+    inner = typeName t <> T.intercalate " " textParameters+    textParameters = map typeInfoToText (typeParameters t)++sumTypesToModules :: Modules -> [SumType] -> Modules+sumTypesToModules = foldr sumTypeToModule++sumTypeToModule :: SumType -> Modules -> Modules+sumTypeToModule st@(SumType t _) = M.alter (Just. updateModule) (typeModule t)+  where+    updateModule Nothing = PSModule {+          psModuleName = typeModule t+        , psImportLines = dropSelf $ typesToImportLines M.empty (getUsedTypes st)+        , psTypes = [st]+        }+    updateModule (Just m) = m {+        psImportLines = dropSelf $ typesToImportLines (psImportLines m) (getUsedTypes st)+      , psTypes = st : psTypes m+      }+    dropSelf = M.delete (typeModule t)++typesToImportLines :: ImportLines -> [TypeInfo] -> ImportLines+typesToImportLines = foldr typeToImportLines++typeToImportLines :: TypeInfo -> ImportLines -> ImportLines+typeToImportLines t = M.alter (Just . updateLine) (typeModule t)+  where+    updateLine Nothing = ImportLine (typeModule t) (S.singleton (typeName t))+    updateLine (Just (ImportLine m types)) = ImportLine m $ S.insert (typeName t) types++unlessM :: Monad m => m Bool -> m () -> m ()+unlessM mbool action = mbool >>= flip unless action
+ src/Language/PureScript/Bridge/SumType.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeSynonymInstances #-}+++{-# LANGUAGE DeriveGeneric #-}+++module Language.PureScript.Bridge.SumType where++import Generics.Deriving+import Data.Text (Text)+import qualified Data.Text as T+import Data.Proxy+import Data.Typeable++import Language.PureScript.Bridge.TypeInfo++data SumType = SumType TypeInfo [DataConstructor] deriving Show++data DataConstructor = DataConstructor {+  sigConstructor :: !Text+, sigValues :: !(Either [TypeInfo] [RecordEntry])+} deriving Show++data RecordEntry = RecordEntry {+  recLabel :: !Text+, recValue :: !TypeInfo+} deriving Show++toSumType :: forall t. (Generic t, Typeable t, GDataConstructor (Rep t)) => Proxy t -> SumType+toSumType p = SumType  (mkTypeInfo p) constructors+  where+    constructors = gToConstructors (from (undefined :: t))++class GDataConstructor f where+  gToConstructors :: f a -> [DataConstructor]++class GRecordEntry f where+  gToRecordEntries :: f a -> [RecordEntry]++instance (Datatype a, GDataConstructor c) =>  GDataConstructor (D1 a c) where+  gToConstructors (M1 c) = gToConstructors c++instance (GDataConstructor a, GDataConstructor b) => GDataConstructor (a :+: b) where+  gToConstructors (_ :: (a :+: b) f) = gToConstructors (undefined :: a f) ++ gToConstructors (undefined :: b f)++instance (Constructor a, GRecordEntry b) => GDataConstructor (C1 a b) where+  gToConstructors c@(M1 r) = [+        DataConstructor {+          sigConstructor = constructor+        , sigValues = values+        }+      ]+    where+      constructor = T.pack $ conName c+      values = if conIsRecord c+        then Right $ gToRecordEntries r+        else Left $ map recValue $ gToRecordEntries r++instance (GRecordEntry a, GRecordEntry b) => GRecordEntry (a :*: b) where+  gToRecordEntries (_ :: (a :*: b) f) = gToRecordEntries (undefined :: a f) ++ gToRecordEntries (undefined :: b f)+++instance GRecordEntry U1 where+  gToRecordEntries _ = []++instance (Selector a, Typeable t) => GRecordEntry (S1 a (K1 R t)) where+  gToRecordEntries e = [+      RecordEntry { recLabel = T.pack (selName e)+      , recValue = mkTypeInfo (Proxy :: Proxy t)+      }+    ]++getUsedTypes :: SumType -> [TypeInfo]+getUsedTypes (SumType _ cs) = foldr constructorToType [] cs++constructorToType :: DataConstructor -> [TypeInfo] -> [TypeInfo]+constructorToType (DataConstructor _ (Left myTs)) ts = concatMap flattenTypeInfo myTs ++ ts+constructorToType (DataConstructor _ (Right rs))  ts = concatMap (flattenTypeInfo . recValue) rs ++ ts
+ src/Language/PureScript/Bridge/Tuple.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE OverloadedStrings #-}+module Language.PureScript.Bridge.Tuple where++import Data.Monoid+import Data.Text (Text)+import qualified Data.Text as T+++import Language.PureScript.Bridge.TypeInfo++data TupleParserState =+  Start | OpenFound | ColonFound | Tuple | NoTuple deriving (Eq, Show)+++tupleBridge :: TypeBridge+tupleBridge t+  | isTuple (typeName t) = Just $ t {+      typePackage = "purescript-tuples"+    , typeModule = if size == 2 then "Data.Tuple" else "Data.Tuple.Nested"+    , typeName = "Tuple" <> if size == 2 then "" else T.pack (show size)+    }+  | otherwise = Nothing+  where+    size = length $ typeParameters t+++step :: TupleParserState -> Char -> TupleParserState+step Start '(' = OpenFound+step Start _ = NoTuple+step OpenFound ',' = ColonFound+step OpenFound _ = NoTuple+step ColonFound ',' = ColonFound+step ColonFound ')' = Tuple+step ColonFound _ = NoTuple+step Tuple _ = NoTuple+step NoTuple _ = NoTuple++isTuple :: Text -> Bool+isTuple = (== Tuple) . T.foldl' step Start
+ src/Language/PureScript/Bridge/TypeInfo.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE OverloadedStrings #-}++module Language.PureScript.Bridge.TypeInfo where+++import Data.Text (Text)+import qualified Data.Text as T+import Data.Proxy+import Data.Typeable+++-- Translates a Haskell type info to a PureScript type info:+type TypeBridge = TypeInfo -> Maybe TypeInfo+++-- Basic info about a data type:+data TypeInfo = TypeInfo {+  -- | Hackage package+  typePackage :: !Text+  -- | Full Module path+, typeModule :: !Text+, typeName :: !Text+, typeParameters :: ![TypeInfo]+} deriving (Eq, Show)++mkTypeInfo :: Typeable t => Proxy t -> TypeInfo+mkTypeInfo = mkTypeInfo' . typeRep++mkTypeInfo' :: TypeRep -> TypeInfo+mkTypeInfo' rep = let+    con = typeRepTyCon rep+  in TypeInfo {+    typePackage = T.pack $ tyConPackage con+  , typeModule = T.pack $ tyConModule con+  , typeName = T.pack $ tyConName con+  , typeParameters = map mkTypeInfo' (typeRepArgs rep)+  }++-- | Put the TypeInfo in a list together with all its typeParameters (recursively)+flattenTypeInfo :: TypeInfo -> [TypeInfo]+flattenTypeInfo t = t : concatMap flattenTypeInfo (typeParameters t)++-- Little helper for type bridge implementers+eqTypeName :: Text -> TypeInfo -> Bool+eqTypeName name = (== name) . typeName
+ src/Language/PureScript/Bridge/TypeParameters.hs view
@@ -0,0 +1,74 @@+-- | As we translate types and not type constructors, we have to pass dummy types+-- | to any type constructor. doBridge will translate all parameter types which+-- | come from a module TypeParameters (e.g. this one) to lower case.+-- | E.g. for translating something like Maybe:+-- | @+-- |   data Maybe' a = Nothing' | Just' a+-- | @+-- | you would use:+-- | @+-- |   import 'Language.PureScript.Bridge'+-- |   import 'Language.PureScript.Bridge.TypeParameters'+-- |   toSumType (Proxy :: Proxy (Maybe A)) -- Note the capital A, which comes from the TypeParameters module.+-- | @++module Language.PureScript.Bridge.TypeParameters where+++data A+data B+data C+data D+data E+data F+data G+data H+data I+data J+data K+data L+data M+data N+data O+data P+data Q+data R+data S+data T+data U+data V+data W+data X+data Y+data Z++-- | You can use those if your type parameters are actually type constructors as well:+-- | @+-- | toSumType (Proxy :: Proxy ('ReaderT' R M1 A))+-- | @+data A1 a+data B1 a+data C1 a+data D1 a+data E1 a+data F1 a+data G1 a+data H1 a+data I1 a+data J1 a+data K1 a+data L1 a+data M1 a+data N1 a+data O1 a+data P1 a+data Q1 a+data R1 a+data S1 a+data T1 a+data U1 a+data V1 a+data W1 a+data X1 a+data Y1 a+data Z1 a
− src/PureScript/Bridge.hs 
@@ -1,56 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module PureScript.Bridge (-    bridgeSumType-  , defaultBridge- ) where---import Data.Text (Text)-import qualified Data.Text as T-import Data.Monoid--import PureScript.Bridge.SumType-import PureScript.Bridge.TypeInfo-import PureScript.Bridge.Tuple-import PureScript.Bridge.Primitives---import Control.Applicative-import Data.Maybe--bridgeSumType :: TypeBridge -> SumType -> SumType-bridgeSumType br (SumType t cs) = SumType t . map (bridgeConstructor br) $ cs--{--- -- Optimistically and recursively translate types: If the passed TypeBridge returns Nothing,- -- then the original TypeInfo is returned with the typePackage field cleared.- -- You don't need to call this function directly, just use bridgeSumType with your TypeBridge---}-doBridge :: TypeBridge -> TypeInfo -> TypeInfo-doBridge br info = let-    translated = info { typePackage = "" }-    res = fromMaybe translated (br info)-  in-    res {-      typeParameters = map (doBridge br) . typeParameters $ res-    }---- | Default bridge for mapping primitive/common types:--- | You can append your own bridges like this:--- | defaultBridge <|> myBridge1 <|> myBridge2-defaultBridge :: TypeBridge-defaultBridge t = stringBridge t-  <|> listBridge t-  <|> maybeBridge t-  <|> eitherBridge t-  <|> intBridge t-  <|> tupleBridge t--bridgeConstructor :: TypeBridge -> DataConstructor -> DataConstructor-bridgeConstructor br (DataConstructor name (Left infos)) =-    DataConstructor name . Left $ map (doBridge br) infos-bridgeConstructor br (DataConstructor name (Right record)) =-    DataConstructor name . Right $ map (bridgeRecordEntry br) record--bridgeRecordEntry :: TypeBridge -> RecordEntry -> RecordEntry-bridgeRecordEntry br (RecordEntry label value) = RecordEntry label $ doBridge br value
− src/PureScript/Bridge/Primitives.hs 
@@ -1,55 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module PureScript.Bridge.Primitives where---import PureScript.Bridge.TypeInfo---intBridge :: TypeBridge-intBridge t-  | eqTypeName "Int" t = Just $ t {-      typePackage = "purescript-prim"-    , typeModule = "Prim"-    }-  | otherwise = Nothing---stringBridge :: TypeBridge-stringBridge t-  | isStringLike = Just $ t {-      typePackage = "purescript-prim"-    , typeModule = "Prim"-    , typeName = "String"-    , typeParameters = []-    }-  | otherwise = Nothing-  where-    isStringLike = isText || isString-    isText = typeName t == "Text" && typePackage t == "text"-    isString = typeName t == "[]" && all ((==) "Char" . typeName) (typeParameters t)--listBridge :: TypeBridge-listBridge t-  | eqTypeName "[]" t = Just $ t {-      typePackage = "purescript-prim"-    , typeModule = "Prim"-    , typeName = "Array"-    }-  | otherwise = Nothing--maybeBridge :: TypeBridge-maybeBridge t-  | eqTypeName "Maybe" t = Just $ t {-      typePackage = "purescript-maybe"-    , typeModule = "Data.Maybe"-    }-  | otherwise = Nothing---eitherBridge :: TypeBridge-eitherBridge t-  | eqTypeName "Either" t = Just $ t {-      typePackage = "purescript-either"-    , typeModule = "Data.Either"-    }-  | otherwise = Nothing
− src/PureScript/Bridge/Printer.hs 
@@ -1,100 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module PureScript.Bridge.Printer where--import Data.Map.Strict (Map)-import qualified Data.Map.Strict as M-import Data.Monoid-import Data.Set (Set)-import qualified Data.Set as S-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.IO as T-import System.FilePath---import PureScript.Bridge.SumType-import PureScript.Bridge.TypeInfo---data PSModule = PSModule {-  psModuleName :: Text-, psImportLines :: Map Text ImportLine-, psTypes :: [SumType]-} deriving Show--data ImportLine = ImportLine {-  importModule :: Text-, importTypes :: Set Text-} deriving Show--type Modules = Map Text PSModule-type ImportLines = Map Text ImportLine--printModule :: FilePath -> PSModule -> IO ()-printModule root m = T.writeFile mPath . moduleToText $ m-  where-    mFile = joinPath . map T.unpack . T.splitOn "." $ psModuleName m-    mPath = root </> mFile--moduleToText :: PSModule -> Text-moduleToText m = T.unlines $-  "module " <> psModuleName m <> "where\n"-  : map importLineToText (M.elems (psImportLines m))-  ++ [ "\n\n" ]-  ++ map sumTypeToText (psTypes m)---importLineToText :: ImportLine -> Text-importLineToText l = "import " <> importModule l <> "(" <> typeList <> ")"-  where-    typeList = T.intercalate ", " (S.toList (importTypes l))--sumTypeToText :: SumType -> Text-sumTypeToText (SumType t cs) = T.unlines $-    "data " <> typeName t <> "="-  : [ "    " <> T.intercalate "  | " (map (constructorToText 4) cs) ]--constructorToText :: Int -> DataConstructor -> Text-constructorToText _ (DataConstructor n (Left ts))  = n <> T.intercalate " " (map typeInfoToText ts)-constructorToText indentation (DataConstructor n (Right rs)) = T.unlines $-      n <> " {"-    : [spaces (indentation + 2) <> T.intercalate intercalation (map recordEntryToText rs)]-    ++ [ spaces indentation <> "}" ]-  where-    intercalation = "\n" <> spaces indentation <> "," <> spaces 2-    spaces c = T.replicate c " "--recordEntryToText :: RecordEntry -> Text-recordEntryToText e = recLabel e <> " :: " <> typeInfoToText (recValue e)---typeInfoToText :: TypeInfo -> Text-typeInfoToText t = if length textParameters > 1 then "(" <> inner <> ")" else inner-  where-    inner = typeName t <> T.intercalate " " textParameters-    textParameters = map typeInfoToText (typeParameters t)--sumTypesToModules :: Modules -> [SumType] -> Modules-sumTypesToModules = foldr sumTypeToModule--sumTypeToModule :: SumType -> Modules -> Modules-sumTypeToModule st@(SumType t _) = M.alter (Just. updateModule) (typeModule t)-  where-    updateModule Nothing = PSModule {-          psModuleName = typeModule t-        , psImportLines = typesToImportLines M.empty (getUsedTypes st)-        , psTypes = [st]-        }-    updateModule (Just m) = m {-        psImportLines = typesToImportLines (psImportLines m) (getUsedTypes st)-      , psTypes = st : psTypes m-      }--typesToImportLines :: ImportLines -> [TypeInfo] -> ImportLines-typesToImportLines = foldr typeToImportLines--typeToImportLines :: TypeInfo -> ImportLines -> ImportLines-typeToImportLines t = M.alter (Just . updateLine) (typeModule t)-  where-    updateLine Nothing = ImportLine (typeModule t) (S.singleton (typeName t))-    updateLine (Just (ImportLine m types)) = ImportLine m $ S.insert (typeName t) types
− src/PureScript/Bridge/SumType.hs 
@@ -1,85 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeSynonymInstances #-}---{-# LANGUAGE DeriveGeneric #-}---module PureScript.Bridge.SumType where--import Generics.Deriving-import Data.Text (Text)-import qualified Data.Text as T-import Data.Proxy-import Data.Typeable--import PureScript.Bridge.TypeInfo--data SumType = SumType TypeInfo [DataConstructor] deriving Show--data DataConstructor = DataConstructor {-  sigConstructor :: Text-, sigValues :: Either [TypeInfo] [RecordEntry]-} deriving Show--data RecordEntry = RecordEntry {-  recLabel :: Text-, recValue :: TypeInfo-} deriving Show--toSumType :: forall t. (Generic t, Typeable t, GDataConstructor (Rep t)) => Proxy t -> SumType-toSumType p = SumType  (mkTypeInfo p) constructors-  where-    constructors = gToConstructors (from (undefined :: t))--class GDataConstructor f where-  gToConstructors :: f a -> [DataConstructor]--class GRecordEntry f where-  gToRecordEntries :: f a -> [RecordEntry]--instance (Datatype a, GDataConstructor c) =>  GDataConstructor (D1 a c) where-  gToConstructors (M1 c) = gToConstructors c--instance (GDataConstructor a, GDataConstructor b) => GDataConstructor (a :+: b) where-  gToConstructors (_ :: (a :+: b) f) = gToConstructors (undefined :: a f) ++ gToConstructors (undefined :: b f)--instance (Constructor a, GRecordEntry b) => GDataConstructor (C1 a b) where-  gToConstructors c@(M1 r) = [-        DataConstructor {-          sigConstructor = constructor-        , sigValues = values-        }-      ]-    where-      constructor = T.pack $ conName c-      values = if conIsRecord c-        then Right $ gToRecordEntries r-        else Left $ map recValue $ gToRecordEntries r--instance (GRecordEntry a, GRecordEntry b) => GRecordEntry (a :*: b) where-  gToRecordEntries (_ :: (a :*: b) f) = gToRecordEntries (undefined :: a f) ++ gToRecordEntries (undefined :: b f)---instance GRecordEntry U1 where-  gToRecordEntries _ = []--instance (Selector a, Typeable t) => GRecordEntry (S1 a (K1 R t)) where-  gToRecordEntries e = [-      RecordEntry { recLabel = T.pack (selName e)-      , recValue = mkTypeInfo (Proxy :: Proxy t)-      }-    ]--getUsedTypes :: SumType -> [TypeInfo]-getUsedTypes (SumType _ cs) = foldr constructorToType [] cs--constructorToType :: DataConstructor -> [TypeInfo] -> [TypeInfo]-constructorToType (DataConstructor _ (Left myTs)) ts = concatMap flattenTypeInfo myTs ++ ts-constructorToType (DataConstructor _ (Right rs))  ts = concatMap (flattenTypeInfo . recValue) rs ++ ts--flattenTypeInfo :: TypeInfo -> [TypeInfo]-flattenTypeInfo t = t : concatMap flattenTypeInfo (typeParameters t)
− src/PureScript/Bridge/Tuple.hs 
@@ -1,39 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module PureScript.Bridge.Tuple where--import Data.Monoid-import Data.Text (Text)-import qualified Data.Text as T---import PureScript.Bridge.TypeInfo--data TupleParserState =-  Start | OpenFound | ColonFound | Tuple | NoTuple deriving (Eq, Show)---tupleBridge :: TypeBridge-tupleBridge t-  | isTuple (typeName t) = Just $ t {-      typePackage = "purescript-tuples"-    , typeModule = if size == 2 then "Data.Tuple" else "Data.Tuple.Nested"-    , typeName = "Tuple" <> if size == 2 then "" else T.pack (show size)-    }-  | otherwise = Nothing-  where-    size = length $ typeParameters t---step :: TupleParserState -> Char -> TupleParserState-step Start '(' = OpenFound-step Start _ = NoTuple-step OpenFound ',' = ColonFound-step OpenFound _ = NoTuple-step ColonFound ',' = ColonFound-step ColonFound ')' = Tuple-step ColonFound _ = NoTuple-step Tuple _ = NoTuple-step NoTuple _ = NoTuple--isTuple :: Text -> Bool-isTuple = (== Tuple) . T.foldl' step Start
− src/PureScript/Bridge/TypeInfo.hs 
@@ -1,44 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module PureScript.Bridge.TypeInfo where---import Data.Text (Text)-import qualified Data.Text as T-import Data.Maybe-import Data.Proxy-import Data.Typeable----- Translates a Haskell type info to a PureScript type info:-type TypeBridge = TypeInfo -> Maybe TypeInfo----- Basic info about a data type:-data TypeInfo = TypeInfo {-  -- | Hackage package-  typePackage :: Text-  -- | Full Module path-, typeModule :: Text-, typeName :: Text-, typeParameters :: [TypeInfo]-} deriving (Eq, Show)--mkTypeInfo :: Typeable t => Proxy t -> TypeInfo-mkTypeInfo = mkTypeInfo' . typeRep--mkTypeInfo' :: TypeRep -> TypeInfo-mkTypeInfo' rep = let-    con = typeRepTyCon rep-  in TypeInfo {-    typePackage = T.pack $ tyConPackage con-  , typeModule = T.pack $ tyConModule con-  , typeName = T.pack $ tyConName con-  , typeParameters = map mkTypeInfo' (typeRepArgs rep)-  }------ Little helper for type bridge implementers-eqTypeName :: Text -> TypeInfo -> Bool-eqTypeName name = (== name) . typeName
test/Tests.hs view
@@ -7,7 +7,7 @@   import Data.Proxy-import PureScript.Bridge.TypeInfo+import Language.PureScript.Bridge.TypeInfo   testTypeInfo :: IO Progress