hasbolt-extras 0.0.0.8 → 0.0.0.9

raw patch · 6 files changed

+74/−35 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• hasbolt-extras.cabal +1/−1
• src/Database/Bolt/Extras/DSL/Internal/Executer.hs +9/−9
• src/Database/Bolt/Extras/DSL/Internal/Instances.hs +18/−1
• src/Database/Bolt/Extras/DSL/Internal/Language.hs +3/−3
• src/Database/Bolt/Extras/DSL/Internal/Types.hs +39/−21

@@ -6,6 +6,10 @@  ## [Unreleased] +## [0.0.0.9] - 2018-05-18+### Added+- New types for conditions in `DSL`.+ ## [0.0.0.8] - 2018-05-14 ### Added - Added `DSL` for `Cypher`.

@@ -1,5 +1,5 @@ name:           hasbolt-extras-version:        0.0.0.8+version:        0.0.0.9 synopsis:       Extras for hasbolt library description:    Extras for hasbolt library homepage:       https://github.com/biocad/hasbolt-extras#readme

@@ -20,23 +20,23 @@ -- | Translates 'Expr' to cypher query. -- execute :: Expr a -> Writer [Text] a-execute (Create s n)        = executeHelperS "CREATE " s n-execute (Match s n)         = executeHelperS "MATCH " s n-execute (OptionalMatch s n) = executeHelperS "OPTIONAL MATCH " s n-execute (Merge s n)         = executeHelperS "MERGE " s n-execute (Where c n)         = executeHelperT "WHERE " c n+execute (Create s n)        = executeHelperC "CREATE " s n+execute (Match s n)         = executeHelperC "MATCH " s n+execute (OptionalMatch s n) = executeHelperC "OPTIONAL MATCH " s n+execute (Merge s n)         = executeHelperC "MERGE " s n+execute (Where c n)         = executeHelperC "WHERE " c n execute (Set t n)           = executeHelperT "SET " t n execute (Delete t n)        = executeHelperT "DELETE " t n execute (DetachDelete t n)  = executeHelperT "DETACH DELETE " t n execute (Return t n)        = executeHelperT "RETURN " t n execute (Text t n)          = tell [t] >> pure n --- | Helper to translate 'Expr' with 'Selector's+-- | Helper to translate 'Expr' with something, which can be translated to cypher. ---executeHelperS :: ToCypher a => Text -> a -> b -> Writer [Text] b-executeHelperS txt s n = tell [txt <> toCypher s] >> pure n+executeHelperC :: ToCypher a => Text -> a -> b -> Writer [Text] b+executeHelperC txt s n = tell [txt <> toCypher s] >> pure n --- | Helper to translate 'Expr' with 'Text's+-- | Helper to translate 'Expr' with 'Text's. -- executeHelperT :: Text -> [Text] -> b -> Writer [Text] b executeHelperT txt t n = tell [txt <> intercalate ", " t] >> pure n

@@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances    #-} {-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE QuasiQuotes          #-} {-# LANGUAGE RecordWildCards      #-} {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-}@@ -7,9 +8,13 @@ module Database.Bolt.Extras.DSL.Internal.Instances () where  import           Control.Monad.Writer                    (execWriter, tell)-import           Data.Text                               (intercalate)+import           Data.Monoid                             ((<>))+import           Data.Text                               (intercalate, pack) import           Database.Bolt.Extras.DSL.Internal.Types+import           Database.Bolt.Extras.Persisted          (fromInt) import           Database.Bolt.Extras.Query.Cypher       (ToCypher (..))+import           NeatInterpolation                       (text)+import           Text.Printf                             (printf)  instance SelectorLike NodeSelector where     withIdentifier idx node = node { nodeIdentifier = Just idx }@@ -82,3 +87,15 @@  instance ToCypher Selectors where   toCypher = intercalate ", " . fmap toCypher++instance ToCypher Cond where+  toCypher (ID t bId)   = pack $ printf "ID(%s)=%d" t (fromInt bId)+  toCypher (IDs t bIds) = pack $ printf "ID(%s) in [%s]" t (intercalate ", " $ fmap (pack . show) bIds)+  toCypher (IN t txts)  = pack $ printf "ID(%s) in [%s]" t (intercalate ", " $ fmap (\s -> [text|"$s"|]) txts)+  toCypher (TC txt)     = txt++instance ToCypher Conds where+  toCypher (fcp :&&: scp) = toCypher fcp <> " AND " <> toCypher scp+  toCypher (fcp :||: scp) = toCypher fcp <> " OR " <> toCypher scp+  toCypher (Not cp)       = "NOT " <> toCypher cp+  toCypher (C cp)         = toCypher cp

@@ -14,7 +14,7 @@  import           Control.Monad.Free                      (Free (..), liftF) import           Data.Text                               (Text)-import           Database.Bolt.Extras.DSL.Internal.Types (Cond, Expr (..),+import           Database.Bolt.Extras.DSL.Internal.Types (Conds (..), Expr (..),                                                           Selectors)  -- | Prepare 'CREATE' query@@ -39,8 +39,8 @@  -- | Prepare 'WHERE' query ---whereF :: Cond -> Free Expr ()-whereF cond = liftF (Where cond ())+whereF :: Conds -> Free Expr ()+whereF conds = liftF (Where conds ())  -- | Prepare 'SET' query --

@@ -12,7 +12,8 @@   , PathSelector (..)   , Selector (..)   , Selectors-  , Cond+  , Cond (..)+  , Conds (..)   , Expr (..)   , SelectorLike (..)   , (#)@@ -22,9 +23,11 @@   , toRelSelector   ) where -import           Data.Map.Strict (toList)-import           Data.Text       (Text)-import           Database.Bolt   (Node (..), URelationship (..), Value (..))+import           Data.Map.Strict                (toList)+import           Data.Text                      (Text)+import           Database.Bolt                  (Node (..), URelationship (..),+                                                 Value (..))+import           Database.Bolt.Extras.Persisted (BoltId)  -- | Class for Selectors, which can update identifier, labels and props. --@@ -57,36 +60,51 @@ -- infixl 2 :!->: infixl 2 :!-:-data PathPart = RelSelector :!->: NodeSelector-              | RelSelector :!-: NodeSelector+data PathPart = RelSelector :!->: NodeSelector -- ^ directed relation+              | RelSelector :!-: NodeSelector  -- ^ not directed relation   deriving (Show, Eq)  infixl 1 :-!: infixl 1 :<-!:-data PathSelector = PathSelector :-!: PathPart-                  | PathSelector :<-!: PathPart-                  | P NodeSelector+data PathSelector = PathSelector :-!: PathPart  -- ^ not directed relation+                  | PathSelector :<-!: PathPart -- ^ directed relation+                  | P NodeSelector              -- ^ starting node of Path   deriving (Show, Eq) -data Selector = PS PathSelector | TS Text+data Selector = PS PathSelector -- ^ path selector+              | TS Text         -- ^ free text selector   deriving (Show, Eq)  type Selectors = [Selector] -type Cond = [Text]+-- | Conditions.+--+data Cond = ID Text BoltId    -- ^ ID(txt) = boltId+          | IDs Text [BoltId] -- ^ ID(txt) IN [boltId1, boltId2, ... ]+          | IN Text [Text]    -- ^ txt IN [txt1, txt2, ... ]+          | TC Text           -- ^ free text condition+  deriving (Show, Eq) +infixr 3 :&&:+infixr 2 :||:+data Conds = Conds :&&: Conds -- ^ 'condition' AND 'condition'+           | Conds :||: Conds -- ^ 'condition' OR 'condition'+           | C Cond           -- ^ single 'condition'+           | Not Conds        -- ^ NOT 'condition'+  deriving (Show, Eq)+ -- | Expression in Cypher language. ---data Expr next = Create Selectors next-               | Match Selectors next-               | OptionalMatch Selectors next-               | Merge Selectors next-               | Where Cond next-               | Set [Text] next-               | Delete [Text] next-               | DetachDelete [Text] next-               | Return [Text] next-               | Text Text next+data Expr next = Create Selectors next        -- ^ CREATE query+               | Match Selectors next         -- ^ MATCH query+               | OptionalMatch Selectors next -- ^ OPTIONAL MATCH query+               | Merge Selectors next         -- ^ MERGE query+               | Where Conds next             -- ^ WHERE query+               | Set [Text] next              -- ^ SET query+               | Delete [Text] next           -- ^ DELETE query+               | DetachDelete [Text] next     -- ^ DETACH DELETE query+               | Return [Text] next           -- ^ RETURN query+               | Text Text next               -- ^ free text query   deriving (Show, Eq, Functor)  defaultNode :: NodeSelector