Feature: generic Show

src/Language/PureScript/Bridge/Printer.hs

@@ -11,7 +11,7 @@
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import           Data.Maybe (isJust)
 import           Data.Monoid ((<>))
 import           Data.Set (Set)
 import qualified Data.Set as Set
 import           Data.Text (Text)
@@ -77,6 +77,9 @@
                 <> _genericsImports settings
                 <> _argonautCodecsImports settings
                 <> _foreignImports settings
+                <> if any (\ (SumType _ _ requestedInstances) -> Show `elem` requestedInstances) (psTypes m)
+                   then [ImportLine "Data.Show.Generic" Nothing (Set.fromList ["genericShow"])]
+                   else [ ]
     allImports = Map.elems $ mergeImportLines otherImports (psImportLines m)
 
 _genericsImports :: Switches.Settings -> [ImportLine]
@@ -212,7 +215,7 @@
             <> " where\n"
             <> "  encodeJson = genericEncodeAeson Argonaut.defaultOptions"
       where
         encodeOpts =
             foreignOptionsToPurescript $ Switches.generateForeign settings
         stpLength = length sumTypeParameters
         extras
@@ -220,7 +223,7 @@
             | otherwise = bracketWrap constraintsInner <> " => "
         sumTypeParameters = filter (isTypeParam t) . Set.toList $ getUsedTypes st
         constraintsInner = T.intercalate ", " $ map instances sumTypeParameters
         instances params = genericInstance settings params <> ", " <> encodeJsonInstance params
         bracketWrap x = "(" <> x <> ")"
     go Decode = mempty
       --   "instance decode"
@@ -259,8 +262,12 @@
             | otherwise = bracketWrap constraintsInner <> " => "
         sumTypeParameters = filter (isTypeParam t) . Set.toList $ getUsedTypes st
         constraintsInner = T.intercalate ", " $ map instances sumTypeParameters
         instances params = genericInstance settings params <> ", " <> decodeJsonInstance params <> ", " <> decodeJsonFieldInstance params
         bracketWrap x = "(" <> x <> ")"
+    go Show = T.unlines
+      [ T.unwords ["instance", "show" <> _typeName t, "∷", "Show", typeInfoToText False t, "where"]
+      , "  " <> T.unwords ["show", "value", "=", "genericShow", "value"]
+      ]
     go i = "derive instance " <> T.toLower c <> _typeName t <> " :: " <> extras i <> c <> " " <> typeInfoToText False t <> postfix i
       where
         c = T.pack $ show i

src/Language/PureScript/Bridge/SumType.hs

@@ -25,6 +25,7 @@ module Language.PureScript.Bridge.SumType
     , sumTypeConstructors
     , recLabel
     , recValue
+    , showing
     ) where
 
 import           Control.Lens hiding (from, to)
@@ -66,7 +67,7 @@ mkSumType p = SumType (mkTypeInfo p) constructors (Encode : Decode : EncodeJson
     constructors = gToConstructors (from (undefined :: t))
 
 -- | Purescript typeclass instances that can be generated for your Haskell types.
-data Instance = Encode | EncodeJson | Decode | DecodeJson | Generic | Newtype | Eq | Ord
+data Instance = Encode | EncodeJson | Decode | DecodeJson | Generic | Newtype | Eq | Ord | Show
   deriving (Eq, Show)
 
 {- | The Purescript typeclass `Newtype` might be derivable if the original
@@ -90,6 +91,9 @@ equal _ (SumType ti dc is) = SumType ti dc . nub $ Eq : is
 order :: Ord a => Proxy a -> SumType t -> SumType t
 order _ (SumType ti dc is) = SumType ti dc . nub $ Eq : Ord : is
 
+showing :: Show a => Proxy a -> SumType t -> SumType t
+showing _ (SumType ti dc is) = SumType ti dc . nub $ Show : is
+
 data DataConstructor (lang :: Language) = DataConstructor
   { _sigConstructor :: !Text
     -- ^ e.g. `Left`/`Right` for `Either`

test/Spec.hs

@@ -39,7 +39,7 @@ allTests = do
              in bst `shouldBe` ti
         it "tests with custom type Foo" $
             let prox = Proxy :: Proxy Foo
-                bst = bridgeSumType (buildBridge defaultBridge) (order prox $ mkSumType prox)
+                bst = bridgeSumType (buildBridge defaultBridge) (showing prox . order prox $ mkSumType prox)
                 st =
                     SumType
                         TypeInfo {_typePackage = "", _typeModule = "TestData", _typeName = "Foo", _typeParameters = []}
@@ -57,11 +57,11 @@ allTests = do
                                     ]
                             }
                         ]
-                        [Eq, Ord, Encode, Decode, EncodeJson, DecodeJson, Generic]
+                        [Show, Eq, Ord, Encode, Decode, EncodeJson, DecodeJson, Generic]
              in bst `shouldBe` st
         it "tests generation of for custom type Foo" $
             let prox = Proxy :: Proxy Foo
-                recType = bridgeSumType (buildBridge defaultBridge) (order prox $ mkSumType prox)
+                recType = bridgeSumType (buildBridge defaultBridge) (showing prox . order prox $ mkSumType prox)
                 recTypeText = sumTypeToText defaultSettings recType
                 txt =
                     T.stripEnd $
@@ -71,6 +71,9 @@ allTests = do
                             , "  | Bar Int"
                             , "  | FooBar Int String"
                             , ""
+                            , "instance showFoo ∷ Show Foo where"
+                            , "  show value = genericShow value"
+                            , ""
                             , "derive instance eqFoo :: Eq Foo"
                             , "derive instance ordFoo :: Ord Foo"
                             , "instance encodeJsonFoo :: EncodeJson Foo where"