diff --git a/DB-record/src/Database/Record/Singleton.hs b/DB-record/src/Database/Record/Singleton.hs index 6e90b2c4..ad8d21b7 100644 --- a/DB-record/src/Database/Record/Singleton.hs +++ b/DB-record/src/Database/Record/Singleton.hs @@ -4,7 +4,20 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} +-- | +-- Module : Database.Record.Singleton +-- Copyright : 2013 Kei Hibino +-- License : BSD3 +-- +-- Maintainer : ex8k.hibino@gmail.com +-- Stability : experimental +-- Portability : unknown +-- +-- This module defines persistable instances for +-- general single field record. module Database.Record.Singleton ( + -- * Singleton type constructor + -- $singletonTypeConstructor Singleton, runSingleton, singleton, singletonWidth, @@ -23,28 +36,39 @@ import Database.Record.FromSql (FromSql(recordFromSql), recordFromSql') import Database.Record.ToSql (ToSql(recordToSql), recordToSql') --- | Singleton value record. +{- $singletonTypeConstructor +Singleton type constructor is useful to avoid overlapped instances. +-} + +-- | General single field record. newtype Singleton a = Singleton { runSingleton :: a } +-- | Wrap into 'Singleton'. singleton :: a -> Singleton a singleton = Singleton +-- | Axiom of 'PersistableRecordWidth' proof object. Single field recrod width is 1. singletonWidth :: PersistableRecordWidth (Singleton a) singletonWidth = persistableRecordWidth 1 +-- | Derived 'PersistableRecordWidth' proof object for 'Singleton'. instance PersistableWidth (Singleton a) where persistableWidth = singletonWidth +-- | Derivation rule of 'PersistableRecord' for 'Singleton'. persistableSingletonFromValue :: PersistableRecordWidth (Singleton a) -> PersistableSqlValue q a -> PersistableRecord q (Singleton a) persistableSingletonFromValue pw pv = persistableRecord pw (singleton . toValue pv . head) ((:[]) . fromValue pv . runSingleton) +-- | Derived 'PersistableRecord' of 'Singleton' derivedPersistableSingleton :: (PersistableWidth (Singleton a), PersistableValue q a) => PersistableRecord q (Singleton a) derivedPersistableSingleton = persistableSingletonFromValue persistableWidth persistableValue +-- | Inference rule for 'RecordFromSql'. instance Persistable q (Singleton a) => FromSql q (Singleton a) where recordFromSql = recordFromSql' +-- | Inference rule for 'RecordToSql'. instance Persistable q (Singleton a) => ToSql q (Singleton a) where recordToSql = recordToSql'