diff --git a/examples/v1/RoseTree.hs b/examples/v1/RoseTree.hs --- a/examples/v1/RoseTree.hs +++ b/examples/v1/RoseTree.hs @@ -8,12 +8,11 @@ module Main where import Control.Arrow - +import Data.Maybe (fromJust) import Data.Profunctor.Product.TH (makeAdaptorAndInstance) - import qualified Database.PostgreSQL.Simple as PSQL - import Opaleye + import Opaleye.Trans @@ -37,7 +36,7 @@ type ReadNode a = NodeP (Column PGInt4) (Column PGInt4) (Column PGInt4) (Column a) -data BranchP i = BranchP +newtype BranchP i = BranchP { branchId :: i } deriving (Show, Eq) @@ -97,9 +96,9 @@ insertTree :: MonadIO m => Rose Int -> OpaleyeT m Int insertTree (Node x xs) = transaction $ do - Just bid <- newBranch - Just rootId <- insertNode 0 bid x - Just treeId <- newTree rootId + bid <- fromJust <$> newBranch + rootId <- fromJust <$> insertNode 0 bid x + treeId <- fromJust <$> newTree rootId mapM_ (insertTree' bid) xs @@ -108,15 +107,15 @@ insertTree' :: Int -> Rose Int -> Transaction () insertTree' bid (Node x xs) = do - Just nbid <- newBranch + nbid <- fromJust <$> newBranch insertNode bid nbid x mapM_ (insertTree' nbid) xs selectTree :: Int -> Transaction (Rose Int) selectTree treeId = do - Just rootId <- selectRootNode treeId - Just (NodeP _ _ nbid x) <- selectNode rootId + rootId <- fromJust <$> selectRootNode treeId + (NodeP _ _ nbid x) <- fromJust <$> selectNode rootId xs <- selectBranch nbid return (Node x xs) diff --git a/examples/v2/RoseTree.hs b/examples/v2/RoseTree.hs --- a/examples/v2/RoseTree.hs +++ b/examples/v2/RoseTree.hs @@ -9,12 +9,11 @@ import Control.Arrow import Control.Monad (void) - +import Data.Maybe (fromJust) import Data.Profunctor.Product.TH (makeAdaptorAndInstance) - import qualified Database.PostgreSQL.Simple as PSQL - import Opaleye + import Opaleye.Trans @@ -26,7 +25,7 @@ instance Functor Rose where fmap f (Node x rs) = Node (f x) (map (fmap f) rs) - fmap f (Leaf x) = Leaf (f x) + fmap f (Leaf x) = Leaf (f x) data NodeP i b a = NodeP @@ -48,7 +47,7 @@ type NullableNodeBranch = NodeBranchP (Column (Nullable PGInt4)) (Column (Nullable PGInt4)) -data BranchP i = BranchP +newtype BranchP i = BranchP { branchId :: i } deriving (Show, Eq) @@ -110,7 +109,7 @@ insertNode :: Int -> Maybe Int -> Int -> Transaction (Maybe Int) insertNode bid (Just nbid) x = do - Just nodeId <- insertReturningFirst nodeTable nodeId + nodeId <- fromJust <$> insertReturningFirst nodeTable nodeId (NodeP Nothing (pgInt4 bid) (pgInt4 x)) insert nodeBranchTable (NodeBranchP (pgInt4 nodeId) (pgInt4 nbid)) return (Just nodeId) @@ -121,22 +120,21 @@ insertTree :: MonadIO m => Rose Int -> OpaleyeT m Int insertTree (Node x xs) = transaction $ do - Just bid <- newBranch - Just rootId <- insertNode 0 (Just bid) x - Just treeId <- newTree rootId + bid <- fromJust <$> newBranch + rootId <- fromJust <$> insertNode 0 (Just bid) x + treeId <- fromJust <$> newTree rootId mapM_ (insertTree' bid) xs return treeId insertTree (Leaf x) = transaction $ do - Just rootId <- insertNode 0 Nothing x - Just treeId <- newTree rootId - return treeId + rootId <- fromJust <$> insertNode 0 Nothing x + fromJust <$> newTree rootId insertTree' :: Int -> Rose Int -> Transaction () insertTree' bid (Node x xs) = do - Just nbid <- newBranch + nbid <- fromJust <$> newBranch insertNode bid (Just nbid) x mapM_ (insertTree' nbid) xs insertTree' bid (Leaf x) = @@ -146,8 +144,8 @@ -- TODO Wrong order selectTree :: Int -> Transaction (Rose Int) selectTree treeId = do - Just rootId <- selectRootNode treeId - Just (NodeP _ _ x, NodeBranchP _ mbid) <- selectNode rootId + rootId <- fromJust <$> selectRootNode treeId + (NodeP _ _ x, NodeBranchP _ mbid) <- fromJust <$> selectNode rootId case mbid of Just nbid -> do xs <- selectBranch nbid @@ -196,10 +194,9 @@ where nodeByBranchId :: Query (ReadNode PGInt4, NullableNodeBranch) nodeByBranchId = byId nodeAndBranch (nodeBranchId . fst) bid - - mkNode - :: (NodeP Int Int Int, NodeBranchP (Maybe Int) (Maybe Int)) - -> Transaction (Rose Int) + + mkNode :: (NodeP Int Int Int, NodeBranchP (Maybe Int) (Maybe Int)) + -> Transaction (Rose Int) mkNode (NodeP _ _ x, NodeBranchP Nothing Nothing) = return (Leaf x) mkNode (NodeP _ _ x, NodeBranchP _ (Just nbid)) = do xs <- selectBranch nbid diff --git a/opaleye-trans.cabal b/opaleye-trans.cabal --- a/opaleye-trans.cabal +++ b/opaleye-trans.cabal @@ -1,12 +1,12 @@ name: opaleye-trans -version: 0.5.0 +version: 0.5.1 synopsis: A monad transformer for Opaleye description: A monad transformer for Opaleye with exceptions -homepage: https://github.com/WraithM/opaleye-trans +homepage: https://github.com/bitnomial/opaleye-trans license: BSD3 license-file: LICENSE author: Matthew Wraith -maintainer: wraithm@gmail.com +maintainer: wraithm@gmail.com, opensource@bitnomial.com copyright: (c) 2015 Bitnomial, Inc category: Database build-type: Simple @@ -15,7 +15,7 @@ source-repository head type: git - location: https://github.com/WraithM/opaleye-trans + location: https://github.com/bitnomial/opaleye-trans library @@ -25,10 +25,10 @@ exposed-modules: Opaleye.Trans , Opaleye.Trans.Exception - build-depends: base >= 4.8 && < 4.12 + build-depends: base >= 4.8 && < 5 , mtl >= 2.2 && < 2.3 , opaleye >= 0.4 && < 0.7 - , postgresql-simple >= 0.4 && < 0.6 + , postgresql-simple >= 0.4 && < 0.7 , product-profunctors >= 0.6 && < 0.11 , transformers >= 0.3 && < 0.6 , exceptions >= 0.6 && < 0.11 @@ -39,10 +39,10 @@ main-is: RoseTree.hs default-language: Haskell2010 - build-depends: base >= 4.8 && < 4.12 + build-depends: base >= 4.8 && < 5 , opaleye >= 0.4 && < 0.7 , opaleye-trans - , postgresql-simple >= 0.4 && < 0.6 + , postgresql-simple >= 0.4 && < 0.7 , product-profunctors >= 0.6 && < 0.11 @@ -50,8 +50,8 @@ hs-source-dirs: examples/v2 main-is: RoseTree.hs default-language: Haskell2010 - build-depends: base >= 4.8 && < 4.12 + build-depends: base >= 4.8 && < 5 , opaleye >= 0.4 && < 0.7 , opaleye-trans - , postgresql-simple >= 0.4 && < 0.6 + , postgresql-simple >= 0.4 && < 0.7 , product-profunctors >= 0.6 && < 0.11