Default to newtype in *SQLValue classes instance chains.

src/Database/PostgreSQL/Value.purs

@@ -21,7 +21,7 @@ import Data.List (List)
 import Data.List as List
 import Data.List.NonEmpty (singleton)
 import Data.Maybe (Maybe(..))
-import Data.Newtype (unwrap)
+import Data.Newtype (class Newtype, unwrap, wrap)
 import Data.String (Pattern(..), split)
 import Data.Time.Duration (Milliseconds(..))
 import Data.Traversable (sequence, traverse)
@@ -37,74 +37,38 @@ class ToSQLValue a where
 class FromSQLValue a where
     fromSQLValue :: Foreign -> Either String a
 
-instance toSQLValueBoolean :: ToSQLValue Boolean where
-    toSQLValue = unsafeToForeign
-
 instance fromSQLValueBoolean :: FromSQLValue Boolean where
     fromSQLValue = lmap show <<< runExcept <<< readBoolean
 
-instance toSQLValueChar :: ToSQLValue Char where
+else instance fromSQLValueChar :: FromSQLValue Char where
-    toSQLValue = unsafeToForeign
-
-instance fromSQLValueChar :: FromSQLValue Char where
     fromSQLValue = lmap show <<< runExcept <<< readChar
 
-instance toSQLValueInt :: ToSQLValue Int where
+else instance fromSQLValueInt :: FromSQLValue Int where
-    toSQLValue = unsafeToForeign
-
-instance fromSQLValueInt :: FromSQLValue Int where
     fromSQLValue = lmap show <<< runExcept <<< readInt
 
-instance toSQLValueNumber :: ToSQLValue Number where
+else instance fromSQLValueNumber :: FromSQLValue Number where
-    toSQLValue = unsafeToForeign
-
-instance fromSQLValueNumber :: FromSQLValue Number where
     fromSQLValue = lmap show <<< runExcept <<< readNumber
 
-instance toSQLValueString :: ToSQLValue String where
+else instance fromSQLValueString :: FromSQLValue String where
-    toSQLValue = unsafeToForeign
-
-instance fromSQLValueString :: FromSQLValue String where
     fromSQLValue = lmap show <<< runExcept <<< readString
 
-instance toSQLValueArray :: (ToSQLValue a) => ToSQLValue (Array a) where
+else instance fromSQLValueArray :: (FromSQLValue a) => FromSQLValue (Array a) where
-    toSQLValue = unsafeToForeign <<< map toSQLValue
-
-instance fromSQLValueArray :: (FromSQLValue a) => FromSQLValue (Array a) where
     fromSQLValue = traverse fromSQLValue <=< lmap show <<< runExcept <<< readArray
 
-instance toSQLValueList :: (ToSQLValue a) => ToSQLValue (List a) where
+else instance fromSQLValueList :: (FromSQLValue a) => FromSQLValue (List a) where
-    toSQLValue = unsafeToForeign <<< Array.fromFoldable <<< map toSQLValue
-
-instance fromSQLValueList :: (FromSQLValue a) => FromSQLValue (List a) where
     fromSQLValue = map List.fromFoldable <<< traverse fromSQLValue <=< lmap show <<< runExcept <<< readArray
 
-instance toSQLValueByteString :: ToSQLValue ByteString where
+else instance fromSQLValueByteString :: FromSQLValue ByteString where
-    toSQLValue = unsafeToForeign
-
-instance fromSQLValueByteString :: FromSQLValue ByteString where
     fromSQLValue x
         | unsafeIsBuffer x = pure $ unsafeFromForeign x
         | otherwise = throwError "FromSQLValue ByteString: not a buffer"
 
-instance toSQLValueInstant :: ToSQLValue Instant where
+else instance fromSQLValueInstant :: FromSQLValue Instant where
-    toSQLValue = instantToString
-
-instance fromSQLValueInstant :: FromSQLValue Instant where
     fromSQLValue v = do
       t <- instantFromString Left Right v
       note ("Instant construction failed for given timestamp: " <> show t) $ instant (Milliseconds t)
 
-instance toSQLValueDate :: ToSQLValue Date where
+else instance fromSQLValueDate :: FromSQLValue Date where
-    toSQLValue date =
-        let
-            y = fromEnum $ year date
-            m = fromEnum $ month date
-            d = fromEnum $ day date
-        in
-            unsafeToForeign $ show y <> "-" <> show m <> "-" <> show d
-
-instance fromSQLValueDate :: FromSQLValue Date where
     fromSQLValue v = do
         s <- lmap show $ runExcept (readString v)
         let
@@ -119,30 +83,17 @@ instance fromSQLValueDate :: FromSQLValue Date where
                 note msg result
             _ -> Left msg
 
-instance toSQLValueJSDate :: ToSQLValue JSDate where
+else instance fromSQLValueJSDate :: FromSQLValue JSDate where
-    toSQLValue = unsafeToForeign
-
-instance fromSQLValueJSDate :: FromSQLValue JSDate where
     fromSQLValue = Right <<< unsafeFromForeign
 
-instance toSQLValueMaybe :: (ToSQLValue a) => ToSQLValue (Maybe a) where
+else instance fromSQLValueMaybe :: (FromSQLValue a) => FromSQLValue (Maybe a) where
-    toSQLValue Nothing = null
-    toSQLValue (Just x) = toSQLValue x
-
-instance fromSQLValueMaybe :: (FromSQLValue a) => FromSQLValue (Maybe a) where
     fromSQLValue x | isNull x  = pure Nothing
                    | otherwise = Just <$> fromSQLValue x
 
-instance toSQLValueForeign :: ToSQLValue Foreign where
+else instance fromSQLValueForeign :: FromSQLValue Foreign where
-    toSQLValue = identity
-
-instance fromSQLValueForeign :: FromSQLValue Foreign where
     fromSQLValue = pure
 
-instance toSQLValueObject ∷ ToSQLValue a ⇒ ToSQLValue (Object a) where
+else instance fromSQLValueObject ∷ FromSQLValue a ⇒ FromSQLValue (Object a) where
-  toSQLValue = unsafeToForeign
-
-instance fromSQLValueObject ∷ FromSQLValue a ⇒ FromSQLValue (Object a) where
   fromSQLValue sql = lmap showErr $ unwrap $ runExceptT main
     where
     showErr ∷ MultipleErrors → String
@@ -153,15 +104,70 @@ instance fromSQLValueObject ∷ FromSQLValue a ⇒ FromSQLValue (Object a) where
       let eso = sequence $ map fromSQLValue objF
       let emo = lmap (singleton <<< ForeignError) eso
       except emo
-
+else instance fromSQLValueDecimal :: FromSQLValue Decimal where
-instance toSQLValueDecimal :: ToSQLValue Decimal where
-    toSQLValue = Decimal.toString >>> unsafeToForeign
-
-instance fromSQLValueDecimal :: FromSQLValue Decimal where
     fromSQLValue v = do
         s <- lmap show $ runExcept (readString v)
         note ("Decimal literal parsing failed: " <> s) (Decimal.fromString s)
 
+else instance fromSQLValueNewtype ∷ (Newtype a b, FromSQLValue b) ⇒ FromSQLValue a where
+    fromSQLValue = map wrap <<< fromSQLValue
+
+instance toSQLValueBoolean :: ToSQLValue Boolean where
+    toSQLValue = unsafeToForeign
+
+else instance toSQLValueChar :: ToSQLValue Char where
+    toSQLValue = unsafeToForeign
+
+else instance toSQLValueInt :: ToSQLValue Int where
+    toSQLValue = unsafeToForeign
+
+else instance toSQLValueNumber :: ToSQLValue Number where
+    toSQLValue = unsafeToForeign
+
+else instance toSQLValueString :: ToSQLValue String where
+    toSQLValue = unsafeToForeign
+
+else instance toSQLValueArray :: (ToSQLValue a) => ToSQLValue (Array a) where
+    toSQLValue = unsafeToForeign <<< map toSQLValue
+
+else instance toSQLValueList :: (ToSQLValue a) => ToSQLValue (List a) where
+    toSQLValue = unsafeToForeign <<< Array.fromFoldable <<< map toSQLValue
+
+else instance toSQLValueByteString :: ToSQLValue ByteString where
+    toSQLValue = unsafeToForeign
+
+else instance toSQLValueInstant :: ToSQLValue Instant where
+    toSQLValue = instantToString
+
+else instance toSQLValueDate :: ToSQLValue Date where
+    toSQLValue date =
+        let
+            y = fromEnum $ year date
+            m = fromEnum $ month date
+            d = fromEnum $ day date
+        in
+            unsafeToForeign $ show y <> "-" <> show m <> "-" <> show d
+
+else instance toSQLValueJSDate :: ToSQLValue JSDate where
+    toSQLValue = unsafeToForeign
+
+else instance toSQLValueMaybe :: (ToSQLValue a) => ToSQLValue (Maybe a) where
+    toSQLValue Nothing = null
+    toSQLValue (Just x) = toSQLValue x
+
+else instance toSQLValueForeign :: ToSQLValue Foreign where
+    toSQLValue = identity
+
+else instance toSQLValueObject ∷ ToSQLValue a ⇒ ToSQLValue (Object a) where
+  toSQLValue = unsafeToForeign
+
+else instance toSQLValueDecimal :: ToSQLValue Decimal where
+    toSQLValue = Decimal.toString >>> unsafeToForeign
+
+else instance toSQLValueNewtype ∷ (Newtype a b, ToSQLValue b) ⇒ ToSQLValue a where
+    toSQLValue = unwrap >>> toSQLValue
+
+
 foreign import null :: Foreign
 foreign import instantToString :: Instant -> Foreign
 foreign import instantFromString :: (String -> Either String Number) -> (Number -> Either String Number) -> Foreign -> Either String Number