Store Printouts in persistent-dbs

3 files changed, 17 insertions, 5 deletions

diff --git a/spec/src/Thermoprint/Printout.hs b/spec/src/Thermoprint/Printout.hs
index 1106d2f..397a1af 100644
--- a/spec/src/Thermoprint/Printout.hs
+++ b/spec/src/Thermoprint/Printout.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
 {-# OPTIONS_HADDOCK show-extensions #-}
 
 -- | This module contains the definition of the structure -- 'Printout' -- used to represent the content of a job
@@ -20,13 +21,16 @@ import Data.Sequence (Seq, (|>), (<|))
 import Data.Text.Lazy (Text)
 
 import Data.ByteString.Lazy (ByteString)
+import qualified Data.ByteString.Lazy as LBS (toStrict)
 
 import GHC.Generics (Generic)
 import Control.DeepSeq (NFData)
 import Data.Aeson (FromJSON(..), ToJSON(..), Value(..))
-import qualified Data.Aeson as JSON (encode, decode)
+import qualified Data.Aeson as JSON (encode, decode, eitherDecodeStrict')
 import Data.Aeson.Types (typeMismatch)
 
+import Database.Persist.Class (PersistField(..))
+
 import Test.QuickCheck.Arbitrary (Arbitrary(..), CoArbitrary, genericShrink)
 import Test.QuickCheck.Modifiers (NonNegative(..))
 import Test.QuickCheck.Gen (oneof, scale)
@@ -48,6 +52,9 @@ import Data.Function (on)
 
 import Data.Foldable (toList, fold)
 
+import Data.Bifunctor
+import Control.Monad ((<=<))
+
 import Data.Encoding (encodeLazyByteStringExplicit, decodeLazyByteString)
 import Data.Encoding.UTF8
 import qualified Data.ByteString.Base64.Lazy as Base64 (encode, decode)
@@ -58,6 +65,10 @@ import Prelude hiding (fold)
 -- | A 'Printout' is a sequence of visually seperated 'Paragraph's
 type Printout = Seq Paragraph
 
+instance PersistField Printout where
+  toPersistValue   = toPersistValue . LBS.toStrict . JSON.encode
+  fromPersistValue = first T.pack . JSON.eitherDecodeStrict' <=< fromPersistValue 
+
 -- | A 'Paragraph' is a non-seperated sequence of 'Chunk's
 type Paragraph = Seq Chunk
 
@@ -127,7 +138,6 @@ instance Monoid Line where
     | otherwise = JuxtaPos (x <| ys)
   x `mappend` y = JuxtaPos $ Seq.fromList [x, y]
 
-
 text :: Text -> Either Block Line
 -- ^ Smart constructor for 'Line'/'Block' which maps word and line boundaries (as determined by 'isSpace' and '(== '\n')' respectively) to the structure of 'Block' and 'Line'.
 --
diff --git a/spec/thermoprint-spec.cabal b/spec/thermoprint-spec.cabal
index da79ee8..942cbe4 100644
--- a/spec/thermoprint-spec.cabal
+++ b/spec/thermoprint-spec.cabal
@@ -44,6 +44,7 @@ library
                      , aeson >=0.9.0 && <1
                      , base64-bytestring >=1.0.0 && <2
                      , encoding >=0.8 && <1
+                     , persistent >=2.2 && <3
   -- hs-source-dirs:      
   default-language:    Haskell2010
 
diff --git a/spec/thermoprint-spec.nix b/spec/thermoprint-spec.nix
index 1825ddd..6d94ef6 100644
--- a/spec/thermoprint-spec.nix
+++ b/spec/thermoprint-spec.nix
@@ -1,6 +1,7 @@
 { mkDerivation, aeson, base, base64-bytestring, bytestring, Cabal
 , cabal-test-quickcheck, containers, deepseq, encoding, hspec
-, QuickCheck, quickcheck-instances, servant, stdenv, text
+, persistent, QuickCheck, quickcheck-instances, servant, stdenv
+, text
 }:
 mkDerivation {
   pname = "thermoprint-spec";
@@ -8,8 +9,8 @@ mkDerivation {
   src = ./.;
   libraryHaskellDepends = [
     aeson base base64-bytestring bytestring Cabal cabal-test-quickcheck
-    containers deepseq encoding QuickCheck quickcheck-instances servant
-    text
+    containers deepseq encoding persistent QuickCheck
+    quickcheck-instances servant text
   ];
   testHaskellDepends = [
     aeson base hspec QuickCheck quickcheck-instances