Deriving Show (#5)

* Initial work on deriving Show

* Add test for Show

* Remove import

* Travis etc.

Author: paf31

.gitignore

@@ -4,3 +4,4 @@
 /output/
 /.psci*
 /src/.webpack.js
+.psc-ide-port

.jscsrc

@@ -0,0 +1,17 @@
+{
+  "preset": "grunt",
+  "disallowSpacesInFunctionExpression": null,
+  "requireSpacesInFunctionExpression": {
+    "beforeOpeningRoundBrace": true,
+    "beforeOpeningCurlyBrace": true
+  },
+  "disallowSpacesInAnonymousFunctionExpression": null,
+  "requireSpacesInAnonymousFunctionExpression": {
+    "beforeOpeningRoundBrace": true,
+    "beforeOpeningCurlyBrace": true
+  },
+  "disallowSpacesInsideObjectBrackets": null,
+  "requireSpacesInsideObjectBrackets": "all",
+  "validateQuoteMarks": "\"",
+  "requireCurlyBraces": null
+}

.jshintrc

@@ -0,0 +1,20 @@
+{
+  "bitwise": true,
+  "eqeqeq": true,
+  "forin": true,
+  "freeze": true,
+  "funcscope": true,
+  "futurehostile": true,
+  "strict": "global",
+  "latedef": true,
+  "maxparams": 1,
+  "noarg": true,
+  "nocomma": true,
+  "nonew": true,
+  "notypeof": true,
+  "singleGroups": true,
+  "undef": true,
+  "unused": true,
+  "eqnull": true,
+  "predef": ["exports"]
+}

.travis.yml

@@ -0,0 +1,23 @@
+language: node_js
+dist: trusty
+sudo: required
+node_js: 6
+env:
+  - PATH=$HOME/purescript:$PATH
+install:
+  - TAG=$(wget -q -O - https://github.com/purescript/purescript/releases/latest --server-response --max-redirect 0 2>&1 | sed -n -e 's/.*Location:.*tag\///p')
+  - wget -O $HOME/purescript.tar.gz https://github.com/purescript/purescript/releases/download/$TAG/linux64.tar.gz
+  - tar -xvf $HOME/purescript.tar.gz -C $HOME/
+  - chmod a+x $HOME/purescript
+  - npm install -g bower
+  - npm install
+script:
+  - bower install --production
+  - npm run -s build
+  - bower install
+  - npm -s test
+after_success:
+- >-
+  test $TRAVIS_TAG &&
+  echo $GITHUB_TOKEN | pulp login &&
+  echo y | pulp publish --no-push

bower.json

@@ -13,6 +13,11 @@
   },
   "dependencies": {
     "purescript-prelude": "^2.0.0",
-    "purescript-monoid": "^2.0.0"
+    "purescript-monoid": "^2.0.0",
+    "purescript-symbols": "^2.0.0",
+    "purescript-foldable-traversable": "^2.0.0"
+  },
+  "devDependencies": {
+    "purescript-console": "^2.0.0"
   }
 }

package.json

@@ -0,0 +1,15 @@
+{
+  "private": true,
+  "scripts": {
+    "clean": "rimraf output && rimraf .pulp-cache",
+    "build": "jshint src && jscs src && psa \"src/**/*.purs\" \"bower_components/purescript-*/src/**/*.purs\" --censor-lib --strict",
+    "test": "psc \"src/**/*.purs\" \"bower_components/purescript-*/src/**/*.purs\" \"test/**/*.purs\" && psc-bundle \"output/**/*.js\" --module Test.Main --main Test.Main | node"
+  },
+  "devDependencies": {
+    "jscs": "^2.8.0",
+    "jshint": "^2.9.1",
+    "pulp": "^8.2.0",
+    "purescript-psa": "^0.3.8",
+    "rimraf": "^2.5.0"
+  }
+}

src/Data/Generic/Rep/Show.purs

@@ -0,0 +1,70 @@
+module Data.Generic.Rep.Show
+  ( class GenericShow
+  , genericShow'
+  , genericShow
+  , class GenericShowArgs
+  , genericShowArgs
+  , class GenericShowFields
+  , genericShowFields
+  ) where
+
+import Prelude (class Show, show, (<>))
+import Data.Foldable (intercalate)
+import Data.Generic.Rep
+import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
+
+class GenericShow a where
+  genericShow' :: a -> String
+
+class GenericShowArgs a where
+  genericShowArgs :: a -> Array String
+
+class GenericShowFields a where
+  genericShowFields :: a -> Array String
+
+instance genericShowNoConstructors :: GenericShow NoConstructors where
+  genericShow' a = genericShow' a
+
+instance genericShowArgsNoArguments :: GenericShowArgs NoArguments where
+  genericShowArgs _ = []
+
+instance genericShowSum :: (GenericShow a, GenericShow b) => GenericShow (Sum a b) where
+  genericShow' (Inl a) = genericShow' a
+  genericShow' (Inr b) = genericShow' b
+
+instance genericShowArgsProduct
+    :: (GenericShowArgs a, GenericShowArgs b)
+    => GenericShowArgs (Product a b) where
+  genericShowArgs (Product a b) = genericShowArgs a <> genericShowArgs b
+
+instance genericShowFieldsProduct
+    :: (GenericShowFields a, GenericShowFields b)
+    => GenericShowFields (Product a b) where
+  genericShowFields (Product a b) = genericShowFields a <> genericShowFields b
+
+instance genericShowConstructor
+  :: (GenericShowArgs a, IsSymbol name)
+  => GenericShow (Constructor name a) where
+  genericShow' (Constructor a) =
+      case genericShowArgs a of
+        [] -> ctor
+        args -> "(" <> intercalate " " ([ctor] <> args) <> ")"
+    where
+      ctor :: String
+      ctor = reflectSymbol (SProxy :: SProxy name)
+
+instance genericShowArgsArgument :: Show a => GenericShowArgs (Argument a) where
+  genericShowArgs (Argument a) = [show a]
+
+instance genericShowArgsRec :: GenericShowFields a => GenericShowArgs (Rec a) where
+  genericShowArgs (Rec a) = ["{ " <> intercalate ", " (genericShowFields a) <> " }"]
+
+instance genericShowFieldsField
+    :: (Show a, IsSymbol name)
+    => GenericShowFields (Field name a) where
+  genericShowFields (Field a) =
+    [reflectSymbol (SProxy :: SProxy name) <> ": " <> show a]
+
+-- | A `Generic` implementation of the `show` member from the `Show` type class.
+genericShow :: forall a rep. (Generic a rep, GenericShow rep) => a -> String
+genericShow x = genericShow' (from x)

test/Main.purs

@@ -6,28 +6,30 @@ import Control.Monad.Eff.Console (CONSOLE, logShow)
 import Data.Generic.Rep as G
 import Data.Generic.Rep.Eq as GEq
 import Data.Generic.Rep.Ord as GOrd
+import Data.Generic.Rep.Show as GShow
 
-data List a = Nil | Cons a (List a)
+data List a = Nil | Cons { head :: a, tail :: List a }
 
-instance genericList :: G.Generic (List a)
-                                  (G.Sum (G.Constructor "Nil" G.NoArguments)
-                                         (G.Constructor "Cons" (G.Product (G.Argument a)
-                                                                          (G.Argument (List a))))) where
-  to (G.Inl (G.Constructor G.NoArguments)) = Nil
-  to (G.Inr (G.Constructor (G.Product (G.Argument x) (G.Argument xs)))) = Cons x xs
-  from Nil = G.Inl (G.Constructor G.NoArguments)
-  from (Cons x xs) = G.Inr (G.Constructor (G.Product (G.Argument x) (G.Argument xs)))
+cons :: forall a. a -> List a -> List a
+cons head tail = Cons { head, tail }
+
+derive instance genericList :: G.Generic (List a) _
 
 instance eqList :: Eq a => Eq (List a) where
   eq x y = GEq.genericEq x y
 
 instance ordList :: Ord a => Ord (List a) where
   compare x y = GOrd.genericCompare x y
 
+instance showList :: Show a => Show (List a) where
+  show x = GShow.genericShow x
+
 main :: Eff (console :: CONSOLE) Unit
 main = do
-  logShow (Cons 1 (Cons 2 Nil) == Cons 1 (Cons 2 Nil))
-  logShow (Cons 1 (Cons 2 Nil) == Cons 1 Nil)
+  logShow (cons 1 (cons 2 Nil))
+
+  logShow (cons 1 (cons 2 Nil) == cons 1 (cons 2 Nil))
+  logShow (cons 1 (cons 2 Nil) == cons 1 Nil)
 
-  logShow (Cons 1 (Cons 2 Nil) `compare` Cons 1 (Cons 2 Nil))
-  logShow (Cons 1 (Cons 2 Nil) `compare` Cons 1 Nil)
+  logShow (cons 1 (cons 2 Nil) `compare` cons 1 (cons 2 Nil))
+  logShow (cons 1 (cons 2 Nil) `compare` cons 1 Nil)