generated from tpl/purs
Default to newtype in *SQLValue classes instance chains.
This commit is contained in:
Tomasz Rybarczyk
parent
bd67de30a1
commit
351a91af68
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user