khibino/haskell-relational-record
1
1
Fork 0
mirror of https://github.com/khibino/haskell-relational-record.git synced 2025-01-05 20:04:49 +03:00
Code Issues Projects Releases Wiki Activity

Simplify internal of Qualify.

Browse Source
This commit is contained in:
Kei Hibino 2014-07-30 14:50:05 +09:00
parent c0b56c5bdb
commit 20a0cab998
1 changed files with 6 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
relational-query/src/Database/Relational/Query/Monad/Qualify.hs
View File

@ -25,43 +25,30 @@ import Database.Relational.Query.Sub (Qualified)
import qualified Database.Relational.Query.Sub as SubQuery
-- | Type for 'Qualify' monad state.
newtype AliasIdContext = AliasIdContext { currentAliasId :: AliasId }
-- | Initial state.
primeAliasIdContext :: AliasIdContext
primeAliasIdContext = AliasIdContext primeAlias
-- | Update state function.
nextAlias :: AliasIdContext -> (AliasId, AliasIdContext)
nextAlias s = (cur, s { currentAliasId = newAliasId cur }) where
cur = currentAliasId s
-- | Monad type to qualify SQL table forms.
newtype Qualify a =
Qualify { runQualify' :: State AliasIdContext a }
Qualify { runQualify' :: State AliasId a }
deriving (Monad, Functor, Applicative)
-- | Run qualify monad.
runQualify :: Qualify a -> AliasIdContext -> (a, AliasIdContext)
runQualify :: Qualify a -> AliasId -> (a, AliasId)
runQualify = runState . runQualify'
-- | Run qualify monad with initial state.
runQualifyPrime :: Qualify a -> (a, AliasIdContext)
runQualifyPrime q = runQualify q primeAliasIdContext
runQualifyPrime :: Qualify a -> (a, AliasId)
runQualifyPrime q = runQualify q primeAlias
-- | Run qualify monad with initial state to get only result.
evalQualifyPrime :: Qualify a -> a
evalQualifyPrime = fst . runQualifyPrime
-- | Make qualify monad from update state function.
qualifyState :: (AliasIdContext -> (a, AliasIdContext)) -> Qualify a
qualifyState :: (AliasId -> (a, AliasId)) -> Qualify a
qualifyState = Qualify . state
-- | Generated new qualifier on internal state.
newAlias :: Qualify AliasId
newAlias = qualifyState nextAlias
newAlias = qualifyState $ \ai -> (ai, newAliasId ai)
unsafeQualifierFromAliasId :: AliasId -> SubQuery.Qualifier
unsafeQualifierFromAliasId = SubQuery.Qualifier . AliasId.unsafeExtractAliasId