diff --git a/src/Database/PostgreSQL/Value.purs b/src/Database/PostgreSQL/Value.purs index 255a3ea..8fd6e3b 100644 --- a/src/Database/PostgreSQL/Value.purs +++ b/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 - toSQLValue = unsafeToForeign - -instance fromSQLValueChar :: FromSQLValue Char where +else instance fromSQLValueChar :: FromSQLValue Char where fromSQLValue = lmap show <<< runExcept <<< readChar -instance toSQLValueInt :: ToSQLValue Int where - toSQLValue = unsafeToForeign - -instance fromSQLValueInt :: FromSQLValue Int where +else instance fromSQLValueInt :: FromSQLValue Int where fromSQLValue = lmap show <<< runExcept <<< readInt -instance toSQLValueNumber :: ToSQLValue Number where - toSQLValue = unsafeToForeign - -instance fromSQLValueNumber :: FromSQLValue Number where +else instance fromSQLValueNumber :: FromSQLValue Number where fromSQLValue = lmap show <<< runExcept <<< readNumber -instance toSQLValueString :: ToSQLValue String where - toSQLValue = unsafeToForeign - -instance fromSQLValueString :: FromSQLValue String where +else instance fromSQLValueString :: FromSQLValue String where fromSQLValue = lmap show <<< runExcept <<< readString -instance toSQLValueArray :: (ToSQLValue a) => ToSQLValue (Array a) where - toSQLValue = unsafeToForeign <<< map toSQLValue - -instance fromSQLValueArray :: (FromSQLValue a) => FromSQLValue (Array a) where +else instance fromSQLValueArray :: (FromSQLValue a) => FromSQLValue (Array a) where fromSQLValue = traverse fromSQLValue <=< lmap show <<< runExcept <<< readArray -instance toSQLValueList :: (ToSQLValue a) => ToSQLValue (List a) where - toSQLValue = unsafeToForeign <<< Array.fromFoldable <<< map toSQLValue - -instance fromSQLValueList :: (FromSQLValue a) => FromSQLValue (List a) where +else instance fromSQLValueList :: (FromSQLValue a) => FromSQLValue (List a) where fromSQLValue = map List.fromFoldable <<< traverse fromSQLValue <=< lmap show <<< runExcept <<< readArray -instance toSQLValueByteString :: ToSQLValue ByteString where - toSQLValue = unsafeToForeign - -instance fromSQLValueByteString :: FromSQLValue ByteString where +else instance fromSQLValueByteString :: FromSQLValue ByteString where fromSQLValue x | unsafeIsBuffer x = pure $ unsafeFromForeign x | otherwise = throwError "FromSQLValue ByteString: not a buffer" -instance toSQLValueInstant :: ToSQLValue Instant where - toSQLValue = instantToString - -instance fromSQLValueInstant :: FromSQLValue Instant where +else 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 - 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 +else 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 - toSQLValue = unsafeToForeign - -instance fromSQLValueJSDate :: FromSQLValue JSDate where +else instance fromSQLValueJSDate :: FromSQLValue JSDate where fromSQLValue = Right <<< unsafeFromForeign -instance toSQLValueMaybe :: (ToSQLValue a) => ToSQLValue (Maybe a) where - toSQLValue Nothing = null - toSQLValue (Just x) = toSQLValue x - -instance fromSQLValueMaybe :: (FromSQLValue a) => FromSQLValue (Maybe a) where +else instance fromSQLValueMaybe :: (FromSQLValue a) => FromSQLValue (Maybe a) where fromSQLValue x | isNull x = pure Nothing | otherwise = Just <$> fromSQLValue x -instance toSQLValueForeign :: ToSQLValue Foreign where - toSQLValue = identity - -instance fromSQLValueForeign :: FromSQLValue Foreign where +else instance fromSQLValueForeign :: FromSQLValue Foreign where fromSQLValue = pure -instance toSQLValueObject ∷ ToSQLValue a ⇒ ToSQLValue (Object a) where - toSQLValue = unsafeToForeign - -instance fromSQLValueObject ∷ FromSQLValue a ⇒ FromSQLValue (Object a) where +else 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 - -instance toSQLValueDecimal :: ToSQLValue Decimal where - toSQLValue = Decimal.toString >>> unsafeToForeign - -instance fromSQLValueDecimal :: FromSQLValue Decimal where +else 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