From b508a6bd35d28260f307acf8ffde8b7acf843a09 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sat, 23 Jan 2016 12:52:15 +0000 Subject: Db layout, persistent-inst. & printer framework --- .../src/Thermoprint/Server/Database/Instances.hs | 33 ++++++++++++++++++++++ 1 file changed, 33 insertions(+) create mode 100644 server/src/Thermoprint/Server/Database/Instances.hs (limited to 'server/src/Thermoprint/Server/Database') diff --git a/server/src/Thermoprint/Server/Database/Instances.hs b/server/src/Thermoprint/Server/Database/Instances.hs new file mode 100644 index 0000000..f5c22fd --- /dev/null +++ b/server/src/Thermoprint/Server/Database/Instances.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} + +module Thermoprint.Server.Database.Instances where + +import Thermoprint.API (Printout, JobStatus, PrintingError) + +import Database.Persist (PersistField(..)) +import Database.Persist.Sql (PersistFieldSql(..)) +import Database.Persist.TH + +import Control.Monad ((<=<)) +import Data.Bifunctor + +import qualified Data.Aeson as JSON (encode, eitherDecodeStrict') + +import Data.ByteString (ByteString) +import qualified Data.ByteString.Lazy as LBS (toStrict) +import qualified Data.Text as T (pack) + +import Data.Proxy + +-- | Instead of deriving an instance using 'derivePersistField', which would use 'show' and 'read', we write our own by hand in order to use json +instance PersistField Printout where + toPersistValue = toPersistValue . LBS.toStrict . JSON.encode + fromPersistValue = first T.pack . JSON.eitherDecodeStrict' <=< fromPersistValue + +instance PersistFieldSql Printout where + sqlType _ = sqlType (Proxy :: Proxy ByteString) + +derivePersistField "PrintingError" +derivePersistField "JobStatus" -- cgit v1.2.3