Divide module about Sigleton wrap type.

DB-record/DB-record.cabal

@@ -19,6 +19,7 @@ library
                         Database.Record.ToSql
                         Database.Record.Persistable
                         Database.Record.KeyConstraint
+                        Database.Record.Singleton
                         Database.Record
                         Database.Record.TH
 

DB-record/src/Database/Record/FromSql.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE UndecidableInstances #-}
 
 -- |
 -- Module      : Database.Record.FromSql
@@ -26,7 +25,7 @@ module Database.Record.FromSql (
   ) where
 
 import Database.Record.Persistable
-  (PersistableRecord, Singleton,
+  (PersistableRecord,
    Persistable(persistable), PersistableType)
 import qualified Database.Record.Persistable as Persistable
 import Database.Record.KeyConstraint
@@ -86,9 +85,6 @@ class FromSql q a where
 recordFromSql' :: Persistable q a => RecordFromSql q a
 recordFromSql' =  recordDeSerializer persistable
 
-instance Persistable q (Singleton a) => FromSql q (Singleton a)  where
-  recordFromSql = recordFromSql'
-
 instance (FromSql q a, FromSql q b) => FromSql q (a, b)  where
   recordFromSql = recordFromSql <&> recordFromSql
 

DB-record/src/Database/Record/Persistable.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 
@@ -11,32 +10,25 @@
 -- Stability   : experimental
 -- Portability : unknown
 module Database.Record.Persistable (
-  Singleton(runSingleton), singleton,
-
   PersistableSqlType(runPersistableNullValue), persistableSqlTypeFromNull,
 
   PersistableRecordWidth(runPersistableRecordWidth),
-  valueWidth, singletonWidth, (<&>), maybeWidth,
+  valueWidth, (<&>), maybeWidth,
   PersistableSqlValue, persistableSqlValue,
+  toValue, fromValue,
 
   PersistableRecord, persistableRecord,
   toRecord, fromRecord, width,
 
-  persistableFromValue, persistableSingletonFromValue,
+  persistableFromValue,
 
   PersistableType(..), sqlNullValue,
   PersistableValue (..), fromSql, toSql,
-  derivedPersistableValueRecord, derivedPersistableSingleton,
+  derivedPersistableValueRecord,
   PersistableWidth (..), persistableRecordWidth,
   Persistable (..), takeRecord
   ) where
 
--- | Singleton value record.
-newtype Singleton a = Singleton { runSingleton :: a }
-
-singleton :: a -> Singleton a
-singleton = Singleton
-
 
 -- | Proof object to specify 'q' is SQL type
 newtype PersistableSqlType q =
@@ -69,9 +61,6 @@ persistableRecordWidth =  PersistableRecordWidth
 valueWidth :: PersistableRecordWidth a
 valueWidth =  persistableRecordWidth 1
 
-singletonWidth :: PersistableRecordWidth (Singleton a)
-singletonWidth =  persistableRecordWidth 1
-
 (<&>) :: PersistableRecordWidth a -> PersistableRecordWidth b -> PersistableRecordWidth (a, b)
 a <&> b = PersistableRecordWidth $ runPersistableRecordWidth a + runPersistableRecordWidth b
 
@@ -99,10 +88,6 @@ persistableFromValue :: PersistableRecordWidth a -> PersistableSqlValue q a -> P
 persistableFromValue pw pv =
   persistableRecord pw (toValue pv . head) ((:[]) . fromValue pv)
 
-persistableSingletonFromValue :: PersistableRecordWidth (Singleton a) -> PersistableSqlValue q a -> PersistableRecord q (Singleton a)
-persistableSingletonFromValue pw pv =
-  persistableRecord pw (singleton . toValue pv . head) ((:[]) . fromValue pv . runSingleton)
-
 persistableVoid :: PersistableRecord q ()
 persistableVoid =  persistableRecord voidWidth (const ()) (const [])
 
@@ -117,9 +102,6 @@ sqlNullValue =  runPersistableNullValue persistableType
 class PersistableWidth a where
   persistableWidth :: PersistableRecordWidth a
 
-instance PersistableWidth (Singleton a) where
-  persistableWidth = singletonWidth
-
 instance (PersistableWidth a, PersistableWidth b) => PersistableWidth (a, b) where
   persistableWidth = persistableWidth <&> persistableWidth
 
@@ -142,9 +124,6 @@ toSql =  fromValue persistableValue
 derivedPersistableValueRecord :: (PersistableWidth a, PersistableValue q a) => PersistableRecord q a
 derivedPersistableValueRecord =  persistableFromValue persistableWidth persistableValue
 
-derivedPersistableSingleton :: (PersistableWidth (Singleton a), PersistableValue q a) => PersistableRecord q (Singleton a)
-derivedPersistableSingleton =  persistableSingletonFromValue persistableWidth persistableValue
-
 
 class PersistableWidth a => Persistable q a where
   persistable :: PersistableRecord q a

DB-record/src/Database/Record/Singleton.hs

@@ -0,0 +1,50 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Database.Record.Singleton (
+  Singleton, runSingleton, singleton,
+
+  singletonWidth,
+  persistableSingletonFromValue,
+  derivedPersistableSingleton
+  ) where
+
+import Database.Record.Persistable
+  (PersistableRecordWidth, persistableRecordWidth,
+   PersistableSqlValue, toValue, fromValue,
+   PersistableRecord, persistableRecord,
+   PersistableWidth (persistableWidth),
+   PersistableValue (persistableValue),
+   Persistable)
+import Database.Record.FromSql (FromSql(recordFromSql), recordFromSql')
+import Database.Record.ToSql (ToSql(recordToSql), recordToSql')
+
+
+-- | Singleton value record.
+newtype Singleton a = Singleton { runSingleton :: a }
+
+singleton :: a -> Singleton a
+singleton = Singleton
+
+singletonWidth :: PersistableRecordWidth (Singleton a)
+singletonWidth =  persistableRecordWidth 1
+
+instance PersistableWidth (Singleton a) where
+  persistableWidth = singletonWidth
+
+persistableSingletonFromValue :: PersistableRecordWidth (Singleton a) -> PersistableSqlValue q a -> PersistableRecord q (Singleton a)
+persistableSingletonFromValue pw pv =
+  persistableRecord pw (singleton . toValue pv . head) ((:[]) . fromValue pv . runSingleton)
+
+derivedPersistableSingleton :: (PersistableWidth (Singleton a), PersistableValue q a) => PersistableRecord q (Singleton a)
+derivedPersistableSingleton =  persistableSingletonFromValue persistableWidth persistableValue
+
+
+instance Persistable q (Singleton a) => FromSql q (Singleton a)  where
+  recordFromSql = recordFromSql'
+
+instance Persistable q (Singleton a) => ToSql q (Singleton a) where
+  recordToSql = recordToSql'

DB-record/src/Database/Record/ToSql.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE UndecidableInstances #-}
 
 -- |
 -- Module      : Database.Record.ToSql
@@ -26,7 +25,7 @@ module Database.Record.ToSql (
   ) where
 
 import Database.Record.Persistable
-  (PersistableRecord, Persistable(persistable), Singleton)
+  (PersistableRecord, Persistable(persistable))
 import Database.Record.KeyConstraint
   (HasKeyConstraint(constraintKey), KeyConstraint, Primary, Unique, unique, index)
 import qualified Database.Record.Persistable as Persistable
@@ -46,9 +45,6 @@ class ToSql q a where
 recordSerializer :: PersistableRecord q a -> RecordToSql q a
 recordSerializer =  createRecordToSql . Persistable.fromRecord
 
-instance Persistable q (Singleton a) => ToSql q (Singleton a) where
-  recordToSql = recordSerializer persistable
-
 (<&>) :: RecordToSql q a -> RecordToSql q b -> RecordToSql q (a, b)
 ra <&> rb = RecordToSql (\(a, b) -> runFromRecord ra a ++ runFromRecord rb b)