Fixes for GHC 8.0.1

1 files changed, 35 insertions, 7 deletions

diff --git a/spec/src/Thermoprint/Printout.hs b/spec/src/Thermoprint/Printout.hs
index 2be0a83..8c33e07 100644
--- a/spec/src/Thermoprint/Printout.hs
+++ b/spec/src/Thermoprint/Printout.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
 {-# OPTIONS_HADDOCK show-extensions #-}
 
 -- | This module contains the definition of the structure -- 'Printout' -- used to represent the content of a job
@@ -63,19 +63,47 @@ import Prelude hiding (fold)
 
 
 -- | A 'Printout' is a sequence of visually seperated 'Paragraph's
-type Printout = Seq Paragraph
+newtype Printout = Printout { getParagraphs :: Seq Paragraph }
+  deriving (Show, Generic, NFData)
+
+instance Eq Paragraph => Eq Printout where
+  (==) = (==) `on` getParagraphs
+
+instance Monoid Printout where
+  mempty = Printout mempty
+  mappend a b = Printout $ (mappend `on` getParagraphs) a b
+
+instance FromJSON Printout where
+  parseJSON = fmap Printout . parseJSON
+
+instance ToJSON Printout where
+  toJSON = toJSON . getParagraphs
+
+instance Arbitrary Printout where
+  arbitrary = Printout <$> arbitrary
 
 -- | A 'Paragraph' is a non-seperated sequence of 'Chunk's
-type Paragraph = Seq Chunk
+newtype Paragraph = Paragraph { getChunks :: Seq Chunk }
+  deriving (Show, Generic, NFData)
+
+instance Eq Chunk => Eq Paragraph where
+  (==) = (==) `on` getChunks
+
+instance Monoid Paragraph where
+  mempty = Paragraph mempty
+  mappend a b = Paragraph $ (mappend `on` getChunks) a b
+
+instance Arbitrary Paragraph where
+  arbitrary = Paragraph <$> arbitrary
 
 instance FromJSON Paragraph where
-  parseJSON o@(Array _)  = Seq.fromList  <$> parseJSON o
-  parseJSON o@(Object _) = Seq.singleton <$> parseJSON o
-  parseJSON o@(String _) = Seq.singleton <$> parseJSON o
+  parseJSON o@(Array _)  = Paragraph . Seq.fromList  <$> parseJSON o
+  parseJSON o@(Object _) = Paragraph . Seq.singleton <$> parseJSON o
+  parseJSON o@(String _) = Paragraph . Seq.singleton <$> parseJSON o
   parseJSON v = typeMismatch "Paragraph" v
 
 instance ToJSON Paragraph where
-  toJSON cs
+  toJSON (Paragraph cs)
     | (a :< as) <- viewl cs
     , Seq.null as = toJSON a
     | otherwise = toJSON $ toList cs