More concise JSON for Printout

1 files changed, 13 insertions, 0 deletions

diff --git a/spec/src/Thermoprint/Printout.hs b/spec/src/Thermoprint/Printout.hs
index 89be802..aae71aa 100644
--- a/spec/src/Thermoprint/Printout.hs
+++ b/spec/src/Thermoprint/Printout.hs
@@ -52,6 +52,7 @@ import Data.Monoid (Monoid(..), (<>))
 import Data.List (dropWhile, dropWhileEnd, groupBy, genericLength, genericReplicate)
 
 import Data.Sequence as Seq (fromList, null, singleton)
+import Data.Sequence (ViewL(..), viewl)
 
 import Data.Function (on)
 
@@ -80,6 +81,18 @@ instance PersistFieldSql Printout where
 -- | A 'Paragraph' is a non-seperated sequence of 'Chunk's
 type Paragraph = Seq Chunk
 
+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 v = typeMismatch "Paragraph" v
+
+instance ToJSON Paragraph where
+  toJSON cs
+    | (a :< as) <- viewl cs
+    , Seq.null as = toJSON a
+    | otherwise = toJSON $ toList cs
+
 -- | We introduce both 'Chunk' and 'Paragraph' mainly to allow 'Raw'.
 -- 
 -- Were we to disallow 'Raw', 'Block' would be identical to 'Paragraph'