persistent-template 1.3.1.4 → 1.3.2.1

raw patch · 2 files changed

+58/−24 lines, 2 filesdep ~bytestringdep ~transformersnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: bytestring, transformers

API changes (from Hackage documentation)

Files

• Database/Persist/TH.hs +55/−22
• persistent-template.cabal +3/−2

@@ -30,6 +30,7 @@     , mkDeleteCascade     , share     , derivePersistField+    , derivePersistFieldJSON     , persistFieldFromEntity       -- * Internal     , packPTH@@ -50,6 +51,7 @@ import Control.Monad.IO.Class (MonadIO) import qualified System.IO as SIO import Data.Text (pack, Text, append, unpack, concat, uncons, cons)+import Data.Text.Encoding (decodeUtf8) import qualified Data.Text.IO as TIO import Data.List (foldl', find) import Data.Maybe (isJust)@@ -59,7 +61,9 @@ import Data.Aeson     ( ToJSON (toJSON), FromJSON (parseJSON), (.=), object     , Value (Object), (.:), (.:?)+    , encode, eitherDecodeStrict'     )+import qualified Data.ByteString.Lazy as BL import Control.Applicative (pure, (<*>)) import Control.Monad.Logger (MonadLogger) import Database.Persist.Sql (sqlType)@@ -723,33 +727,29 @@  -- | produce code similar to the following: ----- instance PersistEntity e => PersistField e where---    toPersistValue = PersistMap $ zip columNames (map toPersistValue . toPersistFields)---    fromPersistValue (PersistMap o) = ---        let columns = HM.fromList x---        in fromPersistValues $ map (\name ->---          case HM.lookup name o of---            Just v ->---              case fromPersistValue v of---                Left e -> error e---                Right r -> r---            Nothing -> error $ "Missing field: " `mappend` unpack name) columnNames ---    fromPersistValue x = Left $ "Expected PersistMap, received: " ++ show x---    sqlType _ = SqlString+-- @+--   instance PersistEntity e => PersistField e where+--      toPersistValue = PersistMap $ zip columNames (map toPersistValue . toPersistFields)+--      fromPersistValue (PersistMap o) = +--          let columns = HM.fromList o+--          in fromPersistValues $ map (\name ->+--            case HM.lookup name columns of+--              Just v -> v+--              Nothing -> PersistNull+--      fromPersistValue x = Left $ "Expected PersistMap, received: " ++ show x+--      sqlType _ = SqlString+-- @ persistFieldFromEntity :: MkPersistSettings -> EntityDef a -> Q [Dec] persistFieldFromEntity mps e = do     ss <- [|SqlString|]     obj <- [|\ent -> PersistMap $ zip (map pack columnNames) (map toPersistValue $ toPersistFields ent)|]     fpv <- [|\x -> let columns = HM.fromList x                     in fromPersistValues $ map-                         (\(nulled, name) ->-                            case HM.lookup name columns of-                                Just v -> case fromPersistValue v of-                                    Left e' -> error $ unpack e'-                                    Right r -> r-                                Nothing -> if nulled then PersistNull-                                    else error $ "Missing field: " `mappend` unpack name)-                         (zip maybeColumns $ map pack columnNames)+                         (\(name) ->+                            case HM.lookup (pack name) columns of+                                Just v -> v+                                Nothing -> PersistNull)+                         $ columnNames           |]      compose <- [|(<=<)|]@@ -770,7 +770,6 @@       entityName = (unpack $ unHaskellName $ entityHaskell e)       entFields = entityFields e       columnNames  = map (unpack . unHaskellName . fieldHaskell) entFields-      maybeColumns = map ((== Nullable ByMaybeAttr) . nullable . fieldAttrs) entFields  -- | Apply the given list of functions to the same @EntityDef@s. --@@ -911,6 +910,40 @@                         case reads $ unpack s' of                             (x, _):_ -> Right x                             [] -> Left $ pack "Invalid " ++ pack dt ++ pack ": " ++ s'|]+    return+        [ persistFieldInstanceD (ConT $ mkName s)+            [ FunD 'toPersistValue+                [ Clause [] (NormalB tpv) []+                ]+            , FunD 'fromPersistValue+                [ Clause [] (NormalB $ fpv `AppE` LitE (StringL s)) []+                ]+            ]+        , persistFieldSqlInstanceD (ConT $ mkName s)+            [ sqlTypeFunD ss+            ]+        ]++-- | Automatically creates a valid 'PersistField' instance for any datatype+-- that has valid 'ToJSON' and 'FromJSON' instances. For a datatype @T@ it+-- generates instances similar to these:+-- +-- @+--    instance PersistField T where+--        toPersistValue = PersistByteString . L.toStrict . encode+--        fromPersistValue = (left T.pack) . eitherDecodeStrict' <=< fromPersistValue+--    instance PersistFieldSql T where+--        sqlType _ = SqlString+-- @+derivePersistFieldJSON :: String -> Q [Dec]+derivePersistFieldJSON s = do+    ss <- [|SqlString|]+    tpv <- [|PersistByteString . BL.toStrict . encode|]+    fpv <- [|\dt v -> do+                bs' <- fromPersistValue v+                case eitherDecodeStrict' bs' of+                    Left e -> Left $ pack "JSON decoding error for " ++ pack dt ++ pack ": " ++ pack e ++ pack ". On Input: " ++ decodeUtf8 bs'+                    Right x -> Right x|]     return         [ persistFieldInstanceD (ConT $ mkName s)             [ FunD 'toPersistValue

@@ -1,5 +1,5 @@ name:            persistent-template-version:         1.3.1.4+version:         1.3.2.1 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -19,8 +19,9 @@                    , template-haskell                    , persistent               >= 1.3       && < 1.4                    , monad-control            >= 0.2       && < 0.4+                   , bytestring               >= 0.9                    , text                     >= 0.5-                   , transformers             >= 0.2+                   , transformers             >= 0.2       && < 0.5                    , containers                    , aeson                    , monad-logger