data-basic 0.2.0.1 → 0.2.0.2
raw patch · 12 files changed
+55/−45 lines, 12 filesdep ~overloaddep ~simple-effectssetup-changed
Dependency ranges changed: overload, simple-effects
Files
- CHANGELOG.md +2/−2
- README.md +7/−7
- Setup.hs +2/−2
- data-basic.cabal +3/−3
- src/Data/Basic.hs +4/−4
- src/Data/Basic/Example.hs +1/−1
- src/Data/Basic/Tutorial.hs +1/−1
- src/Internal/Control/Effects/Basic.hs +22/−17
- src/Internal/Data/Basic/Common.hs +6/−6
- src/Internal/Data/Basic/Compare.hs +5/−0
- src/Internal/Data/Basic/Foreign.hs +1/−1
- src/Internal/Data/Basic/Replace.hs +1/−1
CHANGELOG.md view
@@ -1,2 +1,2 @@-# 0.2.0.1 -* Simple documentation fixes +# 0.2.0.1+* Simple documentation fixes
README.md view
@@ -68,7 +68,7 @@ ### Manipulating data In your main module, import the `Model` and `Data.Basic` so we can start playing with data.-Let's start by inserting some data. All basic functions work in any monad with a `MonadEffectBasic` instance. Practically, this means it integrates well with a mtl-style codebase.+Let's start by inserting some data. All basic functions work in any monad with a `MonadEffect Basic` instance. Practically, this means it integrates well with a mtl-style codebase. ```haskell sandbox :: MonadEffect1 Basic m => m ()@@ -87,13 +87,13 @@ import Prelude hiding (id) import Model-import Data.Basic (MonadEffectBasic)+import Data.Basic (MonadEffect, Basic) import Data.Time (getCurrentTime, getCurrentTimeZone, getCurrentTime, utcToLocalTime) import Control.Monad.IO.Class (MonadIO(..)) import Data.Function ((&)) import Control.Lens ((.~)) -sandbox :: (MonadEffectBasic m, MonadIO m) => m ()+sandbox :: (MonadEffect Basic m, MonadIO m) => m () sandbox = do zone <- liftIO getCurrentTimeZone now <- liftIO getCurrentTime@@ -110,7 +110,7 @@ Let's unpack this a bit. We first do a bit of `time` boilerplate to get the current `LocalTime`. Then we use the lens syntax to set fields. If you haven't seen it before, the pattern is `record & field .~ value`. This returns a new record so we can continue chaining. The `&` operator is actually the flipped version of `$` so we use it also to print the final value and lift that IO operation into our monad. -Now, there's no instance `MonadEffectBasic IO` because the regular old `IO` monad doesn't know anything about your database. To handle that constraint we use the `handleBasicPsql` function. It takes a database connection which we can get using the `connectPostgreSQL` function provided by `postgresql-simple`. So what we do is `handleBasicPsql conn sandbox` and it will provide the database functionality that `sandbox` needs, take care of that constraint leaving only the `MonadIO` of which the `IO` monad is an instance. Here's the final version of our `Main` module.+Now, there's no instance `MonadEffect Basic IO` because the regular old `IO` monad doesn't know anything about your database. To handle that constraint we use the `handleBasicPsql` function. It takes a database connection which we can get using the `connectPostgreSQL` function provided by `postgresql-simple`. So what we do is `handleBasicPsql conn sandbox` and it will provide the database functionality that `sandbox` needs, take care of that constraint leaving only the `MonadIO` of which the `IO` monad is an instance. Here's the final version of our `Main` module. ```haskell {-# LANGUAGE FlexibleContexts, OverloadedStrings #-}@@ -118,14 +118,14 @@ import Prelude hiding (id) import Model-import Data.Basic (MonadEffectBasic, handleBasicPsql)+import Data.Basic (MonadEffect, Basic, handleBasicPsql) import Data.Time (getCurrentTime, getCurrentTimeZone, getCurrentTime, utcToLocalTime) import Control.Monad.IO.Class (MonadIO(..)) import Data.Function ((&)) import Control.Lens ((.~)) import Database.PostgreSQL.Simple -sandbox :: (MonadEffectBasic m, MonadIO m) => m ()+sandbox :: (MonadEffect Basic m, MonadIO m) => m () sandbox = do zone <- liftIO getCurrentTimeZone now <- liftIO getCurrentTime@@ -172,7 +172,7 @@ Let's start by inserting a bunch of rows so we have something to work with. ```haskell-sandbox :: (MonadEffectBasic m, MonadIO m) => m ()+sandbox :: (MonadEffect Basic m, MonadIO m) => m () sandbox = do zone <- liftIO getCurrentTimeZone now <- liftIO getCurrentTime
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple -main = defaultMain +import Distribution.Simple+main = defaultMain
data-basic.cabal view
@@ -1,5 +1,5 @@ name: data-basic-version: 0.2.0.1+version: 0.2.0.2 cabal-version: >=1.10 build-type: Simple license: MIT@@ -45,7 +45,7 @@ Data.Basic build-depends: base >=4.7 && <5,- simple-effects >=0.8.0.2,+ simple-effects >=0.9.0.0, lens >=4.15.1, postgresql-simple >=0.5.2.1, text >=1.2.2.1,@@ -55,7 +55,7 @@ containers >=0.5.7.1, time >=1.6.0.1, bytestring >=0.10.8.1,- overload >=0.1.0.3,+ overload >=0.1.0.4, aeson >=1.0.2.1, lens-aeson >=1.0.0.5, binary >=0.8.3.0,
src/Data/Basic.hs view
@@ -3,13 +3,13 @@ , ForeignKeyConstraint(..), MissingField(..), FieldConstraint(..), AllRows, Entity(..) , EntityKind(..), VirtualTable, virtualTableLens, Getter', FieldOpticProxy, fieldOptic , ForeignKeyLensProxy, foreignKeyLens- , MonadEffectBasic, allRows+ , MonadEffect, Basic, allRows , ddelete, dupdate, insert, dfilter, save, dtake, djoin, dsortOn, dfoldMap, dfoldMapInner, dmap- , dgroupOn- , (<.), (>.), (==.), (/=.), (<=.), (>=.)+ , dgroupOn, rawQuery+ , (<.), (>.), (==.), (/=.), (<=.), (>=.), (&&.), (||.) , ConditionExp(In), Avg(..), Count(..), Min(..), Max(..), Sum(..) , handleBasicPsql, handleBasic, connectPostgreSQL- , mkFromFile, mkFromFiles, printToFile, FromRow(..), field )+ , mkFromFile, mkFromFiles, printToFile, FromRow(..), field, Cached(..) ) where import Internal.Data.Basic.Types
src/Data/Basic/Example.hs view
@@ -115,7 +115,7 @@ author :: ForeignKeyLensProxy (Proxy "blog_post_author_fkey" -> o) => o author = foreignKeyLens @"blog_post_author_fkey" -test1 :: (MonadIO m, MonadEffectBasic m) => m ()+test1 :: (MonadIO m, MonadEffect Basic m) => m () test1 = do void $ ddelete allPosts void $ ddelete allUsers
src/Data/Basic/Tutorial.hs view
@@ -164,7 +164,7 @@ -- Finally, we get to a usage example. -- -- @--- test1 :: ('MonadIO' m, 'MonadEffectBasic' m) => m ()+-- test1 :: ('MonadIO' m, 'MonadEffect' 'Basic' m) => m () -- test1 = do -- 'void' $ 'ddelete' allPosts -- 'void' $ 'ddelete' allUsers
src/Internal/Control/Effects/Basic.hs view
@@ -1,7 +1,9 @@ {-# LANGUAGE RankNTypes, ConstraintKinds, FlexibleContexts, TypeFamilies, ScopedTypeVariables #-} {-# LANGUAGE TypeApplications, TypeOperators, DataKinds, FlexibleInstances, UndecidableInstances #-} {-# LANGUAGE TypeFamilyDependencies #-}-module Internal.Control.Effects.Basic where+{-# LANGUAGE GADTs #-}+module Internal.Control.Effects.Basic (module Internal.Control.Effects.Basic, module Control.Effects)+ where import Internal.Interlude @@ -13,20 +15,25 @@ import Internal.Data.Basic.Sql.Types import Internal.Data.Basic.Compiler -data Basic+newtype Basic = RunSql Type newtype SqlRequest a = SqlRequest { getSqlRequest :: SqlExp } deriving Show -type instance EffectMsg1 Basic = SqlRequest-type instance EffectRes1 Basic = []-type instance EffectCon1 Basic a = FromRow a+data instance Effect Basic method mr where+ RunSqlMsg :: FromRow a => SqlRequest a -> Effect Basic ('RunSql a) 'Msg+ RunSqlRes :: FromRow a => { getRunSqlRes :: [a] } -> Effect Basic ('RunSql a) 'Res -handleBasic :: (forall b. FromRow b => SqlRequest b -> m [b])- -> EffectHandler1 Basic m a -> m a-handleBasic = handleEffect1+effectBasic :: (MonadEffect Basic m, FromRow a) => SqlRequest a -> m [a]+effectBasic = fmap getRunSqlRes . effect . RunSqlMsg +handleBasic ::+ Functor m+ => (forall b. FromRow b => SqlRequest b -> m [b])+ -> EffectHandler Basic m a -> m a+handleBasic f = handleEffect (\(RunSqlMsg r) -> RunSqlRes <$> f r)+ -- | Handles SQL by querying a PostgreSQL database.-handleBasicPsql :: MonadIO m => Connection -> EffectHandler1 Basic m a -> m a+handleBasicPsql :: MonadIO m => Connection -> EffectHandler Basic m a -> m a handleBasicPsql conn = handleBasic (liftIO . runQuerySegment . sqlExpToQuery . getSqlRequest) where@@ -50,21 +57,21 @@ compositeToTuple _ (a :. b :. c) = (Entity a, Entity b, Entity c) runDbStatement :: forall ts m f.- (AllHaveFromRowInstance ts, MonadEffect1 Basic m)+ (AllHaveFromRowInstance ts, MonadEffect Basic m) => DbStatement f ts -> m [DbResult ts] runDbStatement = fmap (map (compositeToTuple (Proxy @ts)))- . effect1 (Proxy :: Proxy Basic)+ . effectBasic . SqlRequest . compileToSql runAggregateStatement :: forall aggr m.- ( MonadEffect1 Basic m+ ( MonadEffect Basic m , FromRow (AggregationResult aggr)) => AggregateStatement aggr 'AM -> m (AggregationResult aggr) runAggregateStatement = fmap unsafeHead- . effect1 (Proxy :: Proxy Basic)+ . effectBasic . SqlRequest . aggregateStatementToSql @@ -82,14 +89,12 @@ runMapStatement :: forall res m f.- ( MonadEffect1 Basic m+ ( MonadEffect Basic m , FromRow res , NoOnly res ) => DbStatement f '[res] -> m [WithoutOnly res] runMapStatement = fmap (fmap (noOnly @res))- . effect1 (Proxy :: Proxy Basic)+ . effectBasic . SqlRequest . compileToSql--type MonadEffectBasic m = MonadEffect1 Basic m
src/Internal/Data/Basic/Common.hs view
@@ -21,7 +21,7 @@ instance (DbStatement fs ~ dbs, ts1 ~ ts2) => LiftedStatement fs ts1 (dbs (ts2 :: [*])) where liftDbExp = identity instance ( res ~ [DbResult ts]- , AllHaveFromRowInstance ts, MonadEffectBasic m )+ , AllHaveFromRowInstance ts, MonadEffect Basic m ) => LiftedStatement fs ts (m (res :: *)) where liftDbExp = runDbStatement @@ -53,15 +53,15 @@ => proxy table -> res allRowsProxy _ = allRows @(TableName table) -rawQuery :: forall a r m. (MonadEffectBasic m, FromRow a, ToRow r)+rawQuery :: forall a r m. (MonadEffect Basic m, FromRow a, ToRow r) => Text -> r -> m [Entity ('FromDb 'Live) a] rawQuery q r = runDbStatement (Raw q r :: DbStatement f '[a]) -insert :: (CanInsert entKind table, MonadEffectBasic m, FromRow table)+insert :: (CanInsert entKind table, MonadEffect Basic m, FromRow table) => Entity entKind table -> m (Entity ('FromDb 'Live) table) insert = fmap unsafeHead . runDbStatement . Insert -dupdate :: (MonadEffectBasic m, FromRow table, Selection f)+dupdate :: (MonadEffect Basic m, FromRow table, Selection f) => (Var 'Updating table -> UpdateExp fields table) -> DbStatement f '[table] -> m [Entity ('FromDb 'Live) table] dupdate f e = runDbStatement (Update f e)@@ -106,7 +106,7 @@ liftMapStatement = identity instance ( res ~ [WithoutOnly ts]- , MonadEffectBasic m+ , MonadEffect Basic m , FromRow ts , NoOnly ts ) => LiftedMapStatement fs ts (m (res :: *)) where@@ -132,7 +132,7 @@ => LiftedAggregation i aggr (aggStat (m :: AM)) where liftAggregation = GroupMappableAggr instance {-# INCOHERENT #-}- ( res ~ AggregationResult aggr, MonadEffectBasic m, FromRow res+ ( res ~ AggregationResult aggr, MonadEffect Basic m, FromRow res , InterpretAsGroupMap (m res) ~ i ) => LiftedAggregation i aggr (m (res :: *)) where liftAggregation = runAggregateStatement
src/Internal/Data/Basic/Compare.hs view
@@ -21,6 +21,8 @@ infix 4 <. infix 4 <=. infix 4 >=.+infix 3 &&.+infix 2 ||. (>.), (==.), (/=.), (<.), (<=.), (>=.) :: ComparableInDbExp a b => a -> b -> ConditionExp (>.) = compareInDbExp GreaterThan@@ -32,3 +34,6 @@ (&&.) :: ConditionExp -> ConditionExp -> ConditionExp (&&.) = BoolOp And++(||.) :: ConditionExp -> ConditionExp -> ConditionExp+(||.) = BoolOp Or
src/Internal/Data/Basic/Foreign.hs view
@@ -56,7 +56,7 @@ type ForeignKeyLensGet fk m = ( ForeignKeyConstraint fk- , MonadEffectBasic m+ , MonadEffect Basic m , Table (ForeignKeyFrom fk) , Table (ForeignKeyTo fk) , ForeignKeyFieldsMatch fk (ForeignKeyFromFields fk) (ForeignKeyToFields fk) )
src/Internal/Data/Basic/Replace.hs view
@@ -61,7 +61,7 @@ , fields ~ UniqueFields pk , PrimaryKeyMatch fields table , SetAllFields (TableFields table) table- , MonadEffectBasic m )+ , MonadEffect Basic m ) => Entity ('FromDb c) table -> m (Entity ('FromDb 'Live) table) save ent = allRows @(TableName table) & dfilter (primaryKeyMatch @fields ent)