From f96d53c71e7ab845e8d072698a95e5f3599f8c18 Mon Sep 17 00:00:00 2001 From: Oliver Charles Date: Fri, 6 Sep 2013 15:48:50 +0000 Subject: [PATCH] Merged lots of stuff into MusicBrainz.Versioning --- musicbrainz-data.cabal | 14 +- src/MusicBrainz/Alias.hs | 14 +- src/MusicBrainz/Annotation.hs | 11 +- src/MusicBrainz/Artist.hs | 23 +- src/MusicBrainz/Artist.hs-boot | 2 +- src/MusicBrainz/ArtistCredit.hs | 3 +- src/MusicBrainz/Class/Cleanup.hs | 3 +- src/MusicBrainz/Class/Create.hs | 49 -- src/MusicBrainz/Class/FindLatest.hs | 19 - src/MusicBrainz/Class/GetEntity.hs | 11 - src/MusicBrainz/Class/MasterRevision.hs | 32 - src/MusicBrainz/Class/NewEntityRevision.hs | 34 - src/MusicBrainz/Class/RealiseTree.hs | 12 - src/MusicBrainz/Class/ResolveReference.hs | 94 --- src/MusicBrainz/Class/Update.hs | 9 +- src/MusicBrainz/Class/ViewRevision.hs | 13 - src/MusicBrainz/Country.hs | 4 +- src/MusicBrainz/Edit.hs | 337 -------- src/MusicBrainz/EditApplication.hs | 4 +- src/MusicBrainz/Editor.hs | 67 -- src/MusicBrainz/Entity.hs | 60 -- src/MusicBrainz/Gender.hs | 4 +- src/MusicBrainz/Generic.hs | 12 +- src/MusicBrainz/Generic.hs-boot | 16 +- src/MusicBrainz/IPI.hs | 22 +- src/MusicBrainz/ISNI.hs | 19 +- src/MusicBrainz/Label.hs | 16 +- src/MusicBrainz/Label.hs-boot | 2 +- src/MusicBrainz/Language.hs | 4 +- src/MusicBrainz/Recording.hs | 16 +- src/MusicBrainz/Recording.hs-boot | 2 +- src/MusicBrainz/Ref.hs | 35 - src/MusicBrainz/Relationship.hs | 5 +- src/MusicBrainz/Relationship/Internal.hs | 20 +- src/MusicBrainz/Release.hs | 16 +- src/MusicBrainz/Release.hs-boot | 2 +- src/MusicBrainz/ReleaseGroup.hs | 16 +- src/MusicBrainz/ReleaseGroup.hs-boot | 2 +- src/MusicBrainz/Revision.hs | 96 --- src/MusicBrainz/Revision/Internal.hs | 81 -- src/MusicBrainz/Script.hs | 4 +- src/MusicBrainz/Tree.hs | 75 -- src/MusicBrainz/Tree.hs-boot | 2 +- src/MusicBrainz/URL.hs | 16 +- src/MusicBrainz/URL.hs-boot | 2 +- src/MusicBrainz/Versioning.hs | 774 ++++++++++++++++++ src/MusicBrainz/Work.hs | 16 +- src/MusicBrainz/Work.hs-boot | 2 +- test/framework/Test/MusicBrainz.hs | 2 +- test/suite/MusicBrainz/AliasType/Tests.hs | 2 +- test/suite/MusicBrainz/Artist/Tests.hs | 2 +- test/suite/MusicBrainz/ArtistCredit/Tests.hs | 5 +- test/suite/MusicBrainz/ArtistType/Tests.hs | 2 +- test/suite/MusicBrainz/Country/Tests.hs | 2 +- test/suite/MusicBrainz/Edit/Tests.hs | 4 +- test/suite/MusicBrainz/Editor/Tests.hs | 5 +- test/suite/MusicBrainz/Gender/Tests.hs | 2 +- test/suite/MusicBrainz/LabelType/Tests.hs | 2 +- test/suite/MusicBrainz/Language/Tests.hs | 2 +- test/suite/MusicBrainz/MediumFormat/Tests.hs | 2 +- test/suite/MusicBrainz/Recording/Tests.hs | 13 +- test/suite/MusicBrainz/Relationship/Tests.hs | 20 +- test/suite/MusicBrainz/Release/Tests.hs | 10 +- test/suite/MusicBrainz/ReleaseGroup/Tests.hs | 9 +- .../MusicBrainz/ReleaseGroupType/Tests.hs | 2 +- .../MusicBrainz/ReleasePackaging/Tests.hs | 2 +- test/suite/MusicBrainz/ReleaseStatus/Tests.hs | 2 +- test/suite/MusicBrainz/Script/Tests.hs | 2 +- test/suite/MusicBrainz/Url/Tests.hs | 8 +- test/suite/MusicBrainz/Work/Tests.hs | 15 +- test/suite/MusicBrainz/WorkType/Tests.hs | 2 +- test/suite/Test/MusicBrainz/CommonTests.hs | 13 +- test/suite/Test/MusicBrainz/Data.hs | 7 +- test/suite/Test/MusicBrainz/Repository.hs | 6 +- 74 files changed, 918 insertions(+), 1317 deletions(-) delete mode 100644 src/MusicBrainz/Class/Create.hs delete mode 100644 src/MusicBrainz/Class/FindLatest.hs delete mode 100644 src/MusicBrainz/Class/GetEntity.hs delete mode 100644 src/MusicBrainz/Class/MasterRevision.hs delete mode 100644 src/MusicBrainz/Class/NewEntityRevision.hs delete mode 100644 src/MusicBrainz/Class/RealiseTree.hs delete mode 100644 src/MusicBrainz/Class/ResolveReference.hs delete mode 100644 src/MusicBrainz/Class/ViewRevision.hs delete mode 100644 src/MusicBrainz/Edit.hs delete mode 100644 src/MusicBrainz/Editor.hs delete mode 100644 src/MusicBrainz/Entity.hs delete mode 100644 src/MusicBrainz/Ref.hs delete mode 100644 src/MusicBrainz/Revision.hs delete mode 100644 src/MusicBrainz/Revision/Internal.hs delete mode 100644 src/MusicBrainz/Tree.hs create mode 100644 src/MusicBrainz/Versioning.hs diff --git a/musicbrainz-data.cabal b/musicbrainz-data.cabal index 454e585..1eb04c9 100644 --- a/musicbrainz-data.cabal +++ b/musicbrainz-data.cabal @@ -39,17 +39,9 @@ Library MusicBrainz.Artist MusicBrainz.ArtistCredit MusicBrainz.Class.Cleanup - MusicBrainz.Class.Create - MusicBrainz.Class.FindLatest - MusicBrainz.Class.GetEntity - MusicBrainz.Class.ResolveReference MusicBrainz.Class.Update - MusicBrainz.Class.ViewRevision MusicBrainz.Country - MusicBrainz.Edit MusicBrainz.EditApplication - MusicBrainz.Editor - MusicBrainz.Entity MusicBrainz.Gender MusicBrainz.IPI MusicBrainz.ISNI @@ -60,22 +52,18 @@ Library MusicBrainz.MBID MusicBrainz.PartialDate MusicBrainz.Recording - MusicBrainz.Ref MusicBrainz.Relationship MusicBrainz.Relationship.Internal MusicBrainz.Release MusicBrainz.ReleaseGroup - MusicBrainz.Revision - MusicBrainz.Revision.Internal MusicBrainz.Script - MusicBrainz.Tree MusicBrainz.URL MusicBrainz.Work MusicBrainz.Util + MusicBrainz.Versioning other-modules: MusicBrainz.Generic MusicBrainz.Merge - MusicBrainz.Class.RealiseTree MusicBrainz.Lens ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -fno-warn-unused-do-bind diff --git a/src/MusicBrainz/Alias.hs b/src/MusicBrainz/Alias.hs index 4033514..07aff92 100644 --- a/src/MusicBrainz/Alias.hs +++ b/src/MusicBrainz/Alias.hs @@ -19,13 +19,10 @@ import Database.PostgreSQL.Simple.FromRow (FromRow(..), field) import Database.PostgreSQL.Simple.ToField (ToField(..)) import Database.PostgreSQL.Simple.ToRow (ToRow(..)) -import MusicBrainz.Entity -import MusicBrainz.Monad -import MusicBrainz.Class.ResolveReference import MusicBrainz.Class.RootTable +import MusicBrainz.Monad import MusicBrainz.PartialDate (PartialDate) -import MusicBrainz.Ref (Ref, Referenceable(..), reference, dereference) -import MusicBrainz.Revision (Revision) +import MusicBrainz.Versioning import qualified Data.Set as Set @@ -135,3 +132,10 @@ class ViewAliases a where , "JOIN " ++ entityName ++ "_revision USING (" ++ entityName ++ "_tree_id) " , "WHERE revision_id = ?" ] + + +-------------------------------------------------------------------------------- +{-| Provide a single lens to view all aliases inside a 'Tree'. -} +class TreeAliases a where + {-| A 'Lens' into all aliases for any 'Tree'. -} + aliases :: Lens' (Tree a) (Set (Alias a)) diff --git a/src/MusicBrainz/Annotation.hs b/src/MusicBrainz/Annotation.hs index 030db0f..e0d3d13 100644 --- a/src/MusicBrainz/Annotation.hs +++ b/src/MusicBrainz/Annotation.hs @@ -6,6 +6,7 @@ module MusicBrainz.Annotation where import Control.Applicative +import Control.Lens import Control.Monad.IO.Class (MonadIO) import Data.String (fromString) import Data.Tagged (Tagged, untag) @@ -14,8 +15,7 @@ import Database.PostgreSQL.Simple (Only(..)) import MusicBrainz.Monad import MusicBrainz.Class.RootTable -import MusicBrainz.Ref (Ref) -import MusicBrainz.Revision (Revision) +import MusicBrainz.Versioning -------------------------------------------------------------------------------- {-| This type class provides functions for working with annotations for specific @@ -37,3 +37,10 @@ class ViewAnnotation a where , "JOIN " ++ entityName ++ "_revision USING (" ++ entityName ++ "_tree_id) " , "WHERE revision_id = ?" ] + + +-------------------------------------------------------------------------------- +{-| Provide a single lens to view the annotation inside a 'Tree'. -} +class TreeAnnotation a where + {-| A 'Lens' into the annotation for any 'Tree'. -} + annotation :: Lens' (Tree a) Text diff --git a/src/MusicBrainz/Artist.hs b/src/MusicBrainz/Artist.hs index 4c9ccbe..5cd6069 100644 --- a/src/MusicBrainz/Artist.hs +++ b/src/MusicBrainz/Artist.hs @@ -33,38 +33,25 @@ import Database.PostgreSQL.Simple.ToRow (ToRow(..)) import qualified Data.Set as Set -import MusicBrainz.Merge -import MusicBrainz.Monad -import MusicBrainz.Annotation import MusicBrainz.Alias -import MusicBrainz.Class.Create -import MusicBrainz.Class.FindLatest -import MusicBrainz.Class.MasterRevision -import MusicBrainz.Class.NewEntityRevision -import MusicBrainz.Class.RealiseTree -import MusicBrainz.Class.ResolveReference +import MusicBrainz.Annotation import MusicBrainz.Class.RootTable import MusicBrainz.Class.Update -import MusicBrainz.Class.ViewRevision import MusicBrainz.Country (Country) -import MusicBrainz.Entity (Add(..), coreData) import MusicBrainz.Gender (Gender) import MusicBrainz.IPI import MusicBrainz.ISNI import MusicBrainz.MBID +import MusicBrainz.Merge +import MusicBrainz.Monad import MusicBrainz.PartialDate (PartialDate) -import MusicBrainz.Ref (Ref, Referenceable(..), reference, dereference) import MusicBrainz.Relationship -import MusicBrainz.Relationship.Internal (HoldsRelationships(..), viewRelationships) -import MusicBrainz.Revision (Revision) -import MusicBrainz.Revision.Internal (CloneRevision(..)) -import MusicBrainz.Tree +import MusicBrainz.Relationship.Internal import MusicBrainz.Util (viewOnce) +import MusicBrainz.Versioning hiding (merge) import {-# SOURCE #-} qualified MusicBrainz.Generic as Generic -import MusicBrainz.Edit (Editable(..)) - -------------------------------------------------------------------------------- {-| The data about an artist in MusicBrainz. -} data Artist = Artist diff --git a/src/MusicBrainz/Artist.hs-boot b/src/MusicBrainz/Artist.hs-boot index 93cc473..6aa7927 100644 --- a/src/MusicBrainz/Artist.hs-boot +++ b/src/MusicBrainz/Artist.hs-boot @@ -2,7 +2,7 @@ module MusicBrainz.Artist where import Database.PostgreSQL.Simple.FromField (FromField) -import MusicBrainz.Ref (Ref) +import MusicBrainz.Versioning data Artist diff --git a/src/MusicBrainz/ArtistCredit.hs b/src/MusicBrainz/ArtistCredit.hs index 2ea9059..549f771 100644 --- a/src/MusicBrainz/ArtistCredit.hs +++ b/src/MusicBrainz/ArtistCredit.hs @@ -21,8 +21,7 @@ import Database.PostgreSQL.Simple.ToRow (ToRow(..)) import MusicBrainz.Util (groupMapTotal) import MusicBrainz.Monad import MusicBrainz.Artist (Artist) -import MusicBrainz.Class.ResolveReference -import MusicBrainz.Ref (Ref, Referenceable(..), reference, dereference) +import MusicBrainz.Versioning import qualified Data.Map as Map import qualified Data.Set as Set diff --git a/src/MusicBrainz/Class/Cleanup.hs b/src/MusicBrainz/Class/Cleanup.hs index ca8463a..a8bc982 100644 --- a/src/MusicBrainz/Class/Cleanup.hs +++ b/src/MusicBrainz/Class/Cleanup.hs @@ -8,9 +8,8 @@ import Control.Monad.Loops (orM) import qualified Data.Set as Set import MusicBrainz.Monad -import MusicBrainz.Ref -import MusicBrainz.Revision import MusicBrainz.Relationship.Internal +import MusicBrainz.Versioning eligibleForCleanup :: (Functor m, MonadIO m, HoldsRelationships a) => Ref (Revision a) -> MusicBrainzT m Bool diff --git a/src/MusicBrainz/Class/Create.hs b/src/MusicBrainz/Class/Create.hs deleted file mode 100644 index bcd5aab..0000000 --- a/src/MusicBrainz/Class/Create.hs +++ /dev/null @@ -1,49 +0,0 @@ -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-| Provides the 'Create' type class for creating new entities. -} -module MusicBrainz.Class.Create - ( Create(..) ) where - -import Database.PostgreSQL.Simple.FromField (FromField) -import Data.String (fromString) -import Data.Tagged (Tagged, untag) - -import MusicBrainz.Monad -import MusicBrainz.Class.RootTable -import MusicBrainz.Class.MasterRevision -import MusicBrainz.Class.NewEntityRevision -import MusicBrainz.Class.RealiseTree -import MusicBrainz.Edit -import MusicBrainz.Editor (Editor) -import MusicBrainz.Ref (Ref) -import MusicBrainz.Revision (Revision) -import MusicBrainz.Revision.Internal (newUnlinkedRevision) -import MusicBrainz.Tree (Tree) - --------------------------------------------------------------------------------- -{-| The create type class allows you to create new entities. -} -class Create a where - {-| Create a new entity, with some starting data, producing a fresh MBID. -} - create :: Ref Editor -> Tree a -> EditT (Ref (Revision a)) - - default create - :: ( Editable a, FromField (Ref a), MasterRevision a, NewEntityRevision a - , RealiseTree a, RootTable a - ) - => Ref Editor -> Tree a -> EditT (Ref (Revision a)) - create editor entity = do - treeId <- realiseTree entity - entityId <- reserveEntityTable (untag (rootTable :: Tagged a String)) - revisionId <- newUnlinkedRevision editor - newEntityRevision revisionId entityId treeId - setMasterRevision entityId revisionId - includeRevision revisionId - return revisionId - - where - - reserveEntityTable table = selectValue $ query_ $ - fromString ("INSERT INTO " ++ table ++ " (master_revision_id) VALUES (-1) RETURNING " ++ table ++ "_id") diff --git a/src/MusicBrainz/Class/FindLatest.hs b/src/MusicBrainz/Class/FindLatest.hs deleted file mode 100644 index 85014bc..0000000 --- a/src/MusicBrainz/Class/FindLatest.hs +++ /dev/null @@ -1,19 +0,0 @@ -module MusicBrainz.Class.FindLatest ( FindLatest(..) ) where - -import Control.Applicative -import Control.Monad.IO.Class - -import MusicBrainz.Monad -import MusicBrainz.Entity -import MusicBrainz.Ref (Ref) - -import qualified Data.Map as Map -import qualified Data.Set as Set - --------------------------------------------------------------------------------- -{-| Attempt to find the latest revision of an entity (type @a@), by a given -'Ref'. To obtain the reference, you can use -'MusicBrainz.Merge.resolveMbid'. -} -class FindLatest a where - findLatest :: (Applicative m, Functor m, MonadIO m) => - Set.Set (Ref a) -> MusicBrainzT m (Map.Map (Ref a) (CoreEntity a)) diff --git a/src/MusicBrainz/Class/GetEntity.hs b/src/MusicBrainz/Class/GetEntity.hs deleted file mode 100644 index 54faf4c..0000000 --- a/src/MusicBrainz/Class/GetEntity.hs +++ /dev/null @@ -1,11 +0,0 @@ -module MusicBrainz.Class.GetEntity where - -import Control.Monad.IO.Class (MonadIO) - -import MusicBrainz.Monad -import MusicBrainz.Entity (Entity) -import MusicBrainz.Ref (Ref) - --------------------------------------------------------------------------------- -class GetEntity a where - getEntity :: (Functor m, MonadIO m) => Ref a -> MusicBrainzT m (Entity a) diff --git a/src/MusicBrainz/Class/MasterRevision.hs b/src/MusicBrainz/Class/MasterRevision.hs deleted file mode 100644 index 0e867a5..0000000 --- a/src/MusicBrainz/Class/MasterRevision.hs +++ /dev/null @@ -1,32 +0,0 @@ -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ScopedTypeVariables #-} -module MusicBrainz.Class.MasterRevision where - -import Control.Monad (void) -import Control.Monad.IO.Class (MonadIO) -import Data.String (fromString) -import Data.Tagged (Tagged, untag) -import Database.PostgreSQL.Simple.ToField (ToField) - -import MusicBrainz.Monad -import MusicBrainz.Class.RootTable -import MusicBrainz.Ref (Ref) -import MusicBrainz.Revision (Revision) - --------------------------------------------------------------------------------- -class MasterRevision a where - setMasterRevision :: (Functor m, MonadIO m) - => Ref a -> Ref (Revision a) -> MusicBrainzT m () - - default setMasterRevision - :: (Functor m, MonadIO m, RootTable a, ToField (Ref a), ToField (Ref (Revision a))) - => Ref a -> Ref (Revision a) -> MusicBrainzT m () - setMasterRevision entityId revisionId = void $ - execute q (revisionId, entityId) - where - table = untag (rootTable :: Tagged a String) - q = fromString $ unlines - [ "UPDATE " ++ table ++ " SET master_revision_id = ? " - , "WHERE " ++ table ++ "_id = ?" - ] diff --git a/src/MusicBrainz/Class/NewEntityRevision.hs b/src/MusicBrainz/Class/NewEntityRevision.hs deleted file mode 100644 index 191e1ec..0000000 --- a/src/MusicBrainz/Class/NewEntityRevision.hs +++ /dev/null @@ -1,34 +0,0 @@ -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ScopedTypeVariables #-} -module MusicBrainz.Class.NewEntityRevision where - -import Control.Monad (void) -import Control.Monad.IO.Class (MonadIO) -import Database.PostgreSQL.Simple.ToField (ToField) -import Data.String (fromString) -import Data.Tagged (Tagged, untag) - -import MusicBrainz.Monad -import MusicBrainz.Class.RootTable -import MusicBrainz.Ref (Ref) -import MusicBrainz.Revision (Revision) -import MusicBrainz.Tree (Tree) - --------------------------------------------------------------------------------- -class NewEntityRevision a where - newEntityRevision :: (Functor m, MonadIO m) - => Ref (Revision a) -> Ref a -> Ref (Tree a) -> MusicBrainzT m () - - default newEntityRevision - :: (Functor m, MonadIO m, RootTable a - , ToField (Ref (Tree a)), ToField (Ref (Revision a)), ToField (Ref a)) - => Ref (Revision a) -> Ref a -> Ref (Tree a) -> MusicBrainzT m () - newEntityRevision revisionId entityId entityTreeId = void $ - execute q (entityId, revisionId, entityTreeId) - where - entityName = untag (rootTable :: Tagged a String) - q = fromString $ unlines - [ "INSERT INTO " ++ entityName ++ "_revision (" ++ entityName ++ "_id, revision_id, " ++ entityName ++ "_tree_id) " - , "VALUES (?, ?, ?)" - ] diff --git a/src/MusicBrainz/Class/RealiseTree.hs b/src/MusicBrainz/Class/RealiseTree.hs deleted file mode 100644 index 05d1bf3..0000000 --- a/src/MusicBrainz/Class/RealiseTree.hs +++ /dev/null @@ -1,12 +0,0 @@ -module MusicBrainz.Class.RealiseTree where - -import Control.Monad.IO.Class (MonadIO) - -import MusicBrainz.Monad -import MusicBrainz.Ref (Ref) -import MusicBrainz.Tree (Tree) - --------------------------------------------------------------------------------- -class RealiseTree a where - realiseTree :: (Functor m, MonadIO m) - => Tree a -> MusicBrainzT m (Ref (Tree a)) diff --git a/src/MusicBrainz/Class/ResolveReference.hs b/src/MusicBrainz/Class/ResolveReference.hs deleted file mode 100644 index 1a1b970..0000000 --- a/src/MusicBrainz/Class/ResolveReference.hs +++ /dev/null @@ -1,94 +0,0 @@ -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -module MusicBrainz.Class.ResolveReference where - -import Control.Applicative -import Control.Monad.IO.Class (MonadIO) -import Data.Maybe (listToMaybe) -import Data.String (fromString) -import Data.Tagged (Tagged, untag) -import Database.PostgreSQL.Simple (Only(..)) -import Database.PostgreSQL.Simple.FromField (FromField) -import MusicBrainz.Monad -import MusicBrainz.Class.RootTable -import MusicBrainz.MBID (MBID) -import MusicBrainz.Ref (Ref, RefSpec) -import MusicBrainz.Revision (Revision) - --------------------------------------------------------------------------------- -class ResolveReference a where - {-| Attempt to resolve a reference from its attributes. If the attributes - don't actually correspond to an entity in the database, then 'Nothing' is - returned. -} - resolveReference - :: (Functor m, MonadIO m) => RefSpec a -> MusicBrainzT m (Maybe (Ref a)) - - default resolveReference - :: (Functor m, MonadIO m, GenericResolver a (RefSpec a)) - => RefSpec a -> MusicBrainzT m (Maybe (Ref a)) - resolveReference = genericResolveReference - - --------------------------------------------------------------------------------- -class RefSpec a ~ r => GenericResolver a r | r -> a where - genericResolveReference - :: (Functor m, MonadIO m) - => r -> MusicBrainzT m (Maybe (Ref a)) - -instance (RootTable a, FromField (Ref a), RefSpec a ~ MBID a) => GenericResolver a (MBID a) where - genericResolveReference entityMbid = - listToMaybe . map fromOnly <$> query q (Only entityMbid) - where - eName = untag (rootTable :: Tagged a String) - q = fromString $ unlines - [ "WITH RECURSIVE path (revision_id, " ++ eName ++ "_id, child_revision_id, created_at, is_master_revision_id) " - , "AS (" - , " SELECT " - , " " ++ eName ++ "_revision.revision_id, " - , " " ++ eName ++ "_revision." ++ eName ++ "_id, " - , " revision_parent.revision_id AS child_revision_id, " - , " created_at, " - , " TRUE as is_master_revision_id " - , " FROM " ++ eName ++ "_revision " - , " JOIN " ++ eName ++ " USING (" ++ eName ++ "_id) " - , " JOIN revision USING (revision_id) " - , " LEFT JOIN revision_parent ON (revision_parent.parent_revision_id = revision.revision_id) " - , " WHERE " ++ eName ++ "_id = ? AND master_revision_id = " ++ eName ++ "_revision.revision_id " - , " " - , " UNION " - , " " - , " SELECT " - , " " ++ eName ++ "_revision.revision_id, " - , " " ++ eName ++ "_revision." ++ eName ++ "_id, " - , " revision_parent.revision_id, " - , " revision.created_at, " - , " master_revision_id = " ++ eName ++ "_revision.revision_id AS is_master_revision_id " - , " FROM path " - , " JOIN " ++ eName ++ "_revision ON (path.child_revision_id = " ++ eName ++ "_revision.revision_id) " - , " JOIN revision ON (revision.revision_id = " ++ eName ++ "_revision.revision_id) " - , " JOIN " ++ eName ++ " ON (" ++ eName ++ "." ++ eName ++ "_id = " ++ eName ++ "_revision." ++ eName ++ "_id) " - , " LEFT JOIN revision_parent ON (revision_parent.parent_revision_id = " ++ eName ++ "_revision.revision_id) " - , ") " - , "SELECT " ++ eName ++ "_id " - , "FROM path " - , "WHERE is_master_revision_id " - , "ORDER BY created_at DESC, revision_id DESC " - , "LIMIT 1 " - ] - -instance RootTable a => GenericResolver (Revision a) Int where - genericResolveReference revisionId = - listToMaybe . map fromOnly <$> query q (Only revisionId) - where - eName = untag (rootTable :: Tagged a String) - q = fromString $ unlines - [ "SELECT revision_id " - , "FROM " ++ eName ++ "_revision " - , "WHERE revision_id = ?" - ] diff --git a/src/MusicBrainz/Class/Update.hs b/src/MusicBrainz/Class/Update.hs index 26812d0..84a04fd 100644 --- a/src/MusicBrainz/Class/Update.hs +++ b/src/MusicBrainz/Class/Update.hs @@ -2,15 +2,8 @@ module MusicBrainz.Class.Update ( Update(update) ) where -import MusicBrainz.Class.NewEntityRevision -import MusicBrainz.Class.RealiseTree -import MusicBrainz.Class.ViewRevision -import MusicBrainz.Edit -import MusicBrainz.Editor -import MusicBrainz.Ref import MusicBrainz.Relationship.Internal -import MusicBrainz.Revision -import MusicBrainz.Tree +import MusicBrainz.Versioning -------------------------------------------------------------------------------- {-| This type class allows one version of an entity to be replaced diff --git a/src/MusicBrainz/Class/ViewRevision.hs b/src/MusicBrainz/Class/ViewRevision.hs deleted file mode 100644 index 7f68b62..0000000 --- a/src/MusicBrainz/Class/ViewRevision.hs +++ /dev/null @@ -1,13 +0,0 @@ -module MusicBrainz.Class.ViewRevision where - -import Control.Monad.IO.Class (MonadIO) -import MusicBrainz.Monad -import MusicBrainz.Entity (CoreEntity) -import MusicBrainz.Ref (Ref) -import MusicBrainz.Revision (Revision) - --------------------------------------------------------------------------------- -{-| View a specific revision, along with the basic 'treeData'. -} -class ViewRevision a where - viewRevision :: (Functor m, MonadIO m) - => Ref (Revision a) -> MusicBrainzT m (CoreEntity a) diff --git a/src/MusicBrainz/Country.hs b/src/MusicBrainz/Country.hs index 6f51b90..fc321b0 100644 --- a/src/MusicBrainz/Country.hs +++ b/src/MusicBrainz/Country.hs @@ -17,9 +17,7 @@ import Database.PostgreSQL.Simple.ToField (ToField(..)) import Database.PostgreSQL.Simple.ToRow (ToRow(..)) import MusicBrainz.Monad -import MusicBrainz.Class.ResolveReference -import MusicBrainz.Entity -import MusicBrainz.Ref (Referenceable(..), Ref, dereference, reference) +import MusicBrainz.Versioning -------------------------------------------------------------------------------- {-| A country where artists resides, labels are founded, releases are released diff --git a/src/MusicBrainz/Edit.hs b/src/MusicBrainz/Edit.hs deleted file mode 100644 index 55784ef..0000000 --- a/src/MusicBrainz/Edit.hs +++ /dev/null @@ -1,337 +0,0 @@ -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ScopedTypeVariables #-} -module MusicBrainz.Edit where - -import Control.Applicative -import Control.Lens -import Control.Monad (void) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Control.Monad.Trans (lift) -import Control.Monad.Trans.Writer (WriterT(..), tell) -import Data.Maybe (listToMaybe) -import Data.String (fromString) -import Data.Tagged (Tagged, untag) -import Data.Text (Text) -import Database.PostgreSQL.Simple ((:.)(..), Only(..)) -import Database.PostgreSQL.Simple.FromField (FromField(..)) -import Database.PostgreSQL.Simple.FromRow (FromRow(..), field) -import Database.PostgreSQL.Simple.SqlQQ (sql) -import Database.PostgreSQL.Simple.ToField (ToField(..)) -import Database.PostgreSQL.Simple.ToRow (ToRow(..)) -import GHC.Enum (boundedEnumFrom) - -import MusicBrainz.Util (viewOnce) -import MusicBrainz.Monad -import MusicBrainz.Merge -import MusicBrainz.Class.FindLatest -import MusicBrainz.Class.MasterRevision -import MusicBrainz.Class.NewEntityRevision -import MusicBrainz.Class.RealiseTree -import MusicBrainz.Class.ResolveReference -import MusicBrainz.Class.RootTable -import MusicBrainz.Class.ViewRevision -import MusicBrainz.Editor (Editor) -import MusicBrainz.Entity -import MusicBrainz.Ref (Ref, Referenceable(..), reference, dereference) -import MusicBrainz.Revision (Revision, mergeBase) -import MusicBrainz.Revision.Internal -import MusicBrainz.Tree (Tree, ViewTree(..)) - - --------------------------------------------------------------------------------- -{-| An edit bundles up multiple 'Revision's that have not yet been applied to -entities. Editors can then vote on these edits to decide if they should be -merge, which ModBot can then later merge (or reject) once a consensus -emerges. -} -data Edit = Edit - { editStatus :: EditStatus - } - deriving (Eq, Show) - -instance Referenceable Edit where - type RefSpec Edit = Int - -instance FromField (Ref Edit) where - fromField f v = view reference <$> fromField f v - -instance ToField EditStatus where - toField = toField . fromEnum - -instance ToField (Ref Edit) where - toField = toField . dereference - -instance ResolveReference Edit where - resolveReference editId = listToMaybe . map fromOnly <$> query q (Only editId) - where q = [sql| SELECT edit_id FROM edit WHERE edit_id = ? |] - - --------------------------------------------------------------------------------- -{-| The possible states an edit can be in. -} -data EditStatus = Open | Closed - deriving (Eq, Show) - -instance Enum EditStatus where - fromEnum Open = 1 - fromEnum Closed = 2 - - toEnum 1 = Open - toEnum 2 = Closed - toEnum n = error $ show n ++ " cannot be converted to EditStatus" - - enumFrom = boundedEnumFrom - -instance Bounded EditStatus where - minBound = Open - maxBound = Closed - - --------------------------------------------------------------------------------- -{-| An edit note is a comment that can be left by editors on edit notes, to -have a discussion about the changes being made, or to provide references for -other editors to verify changes against. -} -data EditNote = EditNote - { editNoteBody :: !Text - , editNoteAuthor :: !(Ref Editor) - } - deriving (Eq, Show) - -instance Referenceable EditNote where - type RefSpec EditNote = Int - -instance FromField (Ref EditNote) where - fromField f v = view reference <$> fromField f v - -instance FromRow EditNote where - fromRow = EditNote <$> field <*> field - -instance ToRow EditNote where - toRow EditNote{..} = [ toField editNoteAuthor - , toField editNoteBody - ] - - --------------------------------------------------------------------------------- -{-| Given an edit that already exists, run 'EditM' actions against it, to -augment the edit with additional changes. -} -withEdit :: Ref Edit -> EditT a -> MusicBrainz a -withEdit editId action = fst <$> runEditT editId action - - --------------------------------------------------------------------------------- -{-| Open a fresh edit, which can then have revisions added. -} -openEdit :: MusicBrainz (Ref Edit) -openEdit = selectValue $ query - [sql| INSERT INTO edit (status) VALUES (?) RETURNING edit_id |] - (Only Open) - - --------------------------------------------------------------------------------- -mergeRevisionUpstream - :: (Applicative m, MonadIO m, FindLatest a, Mergeable (Tree a) - , NewEntityRevision a, RealiseTree a, MasterRevision a, ViewRevision a - , ViewTree a) - => Ref (Revision a) -> MusicBrainzT m () -mergeRevisionUpstream new = do - newVer <- viewRevision new - let artistId = coreRef newVer - - current <- viewOnce findLatest artistId - if coreRevision current == new - -- We aren't doing a merge at all, but we're simply 'creating' this - -- entity (by setting an upstream revision). - then setMasterRevision artistId new - - else do - ancestor' <- mergeBase new (coreRevision current) >>= traverse viewRevision - case ancestor' of - Nothing -> error "Unable to merge: no common ancestor" - Just ancestor -> do - newTree <- viewTree new - currentTree <- viewTree (coreRevision current) - ancestorTree <- viewTree (coreRevision ancestor) - - case runMerge newTree currentTree ancestorTree MusicBrainz.Merge.merge of - Nothing -> error "Unable to merge: conflict" - Just merged -> do - editorId <- selectValue $ query - [sql| SELECT editor_id FROM revision WHERE revision_id = ? |] - (Only $ coreRevision current) - - treeId <- realiseTree merged - revisionId <- newChildRevision editorId (coreRevision current) treeId - addChild revisionId new - - setMasterRevision artistId revisionId - --------------------------------------------------------------------------------- -data Change = forall entity. - Editable entity => Change (Ref (Revision entity)) - - --------------------------------------------------------------------------------- -{-| Accumulate many changes inside a single Edit. -} -type EditT = MusicBrainzT (WriterT [Change] IO) - - --------------------------------------------------------------------------------- -{-| Include a specific 'Revision' as part of an edit. - -This is a fairly low-level operation, and you should be careful that you only -include revisions that haven't already been merged! -} -includeRevision :: Editable a => Ref (Revision a) -> EditT () -includeRevision = lift . tell . return . Change - - --------------------------------------------------------------------------------- -{-| The 'Editable' class has instances which have versioning and thus can be -included in edits. -} ---class (FindLatest a, MasterRevision a, Mergeable (Tree a), -class (FindLatest a, Mergeable (Tree a), MasterRevision a, NewEntityRevision a, RealiseTree a, ViewTree a, ViewRevision a) => Editable a where - {-| Add a revision into an edit. -} - linkRevisionToEdit :: Ref Edit -> Ref (Revision a) -> MusicBrainz () - - default linkRevisionToEdit - :: (RootTable a, ToField (Ref Edit), ToField (Ref (Revision a))) - => Ref Edit -> Ref (Revision a) -> MusicBrainz () - linkRevisionToEdit editId revisionId = void $ execute q (editId, revisionId) - where - table = "edit_" ++ untag (rootTable :: Tagged a String) - q = fromString $ unlines - [ "INSERT INTO " ++ table ++ " (edit_id, revision_id)" - , " VALUES (?, ?)" - ] - - --------------------------------------------------------------------------------- -runEditT :: Ref Edit -> EditT a -> MusicBrainz (a, [Change]) -runEditT editId action = do - (a, changes) <- fmap runWriterT (nestMb action) >>= liftIO - mapM_ linkChange changes - return (a, changes) - - where - - linkChange :: Change -> MusicBrainz () - linkChange (Change r) = linkRevisionToEdit editId r - - --------------------------------------------------------------------------------- -runUpdate - :: (Editable a, NewEntityRevision a, RealiseTree a, ViewRevision a) - => Ref Editor -> Ref (Revision a) -> Tree a -> EditT (Ref (Revision a)) -runUpdate editor base tree = do - treeId <- realiseTree tree - revisionId <- newChildRevision editor base treeId - includeRevision revisionId - return revisionId - - --------------------------------------------------------------------------------- -{-| Merge one entity into another. -} -merge :: (FindLatest a, Editable a, CloneRevision a) - => Ref Editor -> Ref (Revision a) -> Ref a -> EditT (Ref (Revision a)) -merge editor baseRev targetId = do - -- Find the latest revision to merge into - latestTarget <- viewOnce findLatest targetId - mergeInto <- cloneRevision latestTarget editor - - -- Link this revision to both the old tree and the latest version, - -- and include it in the edit. - includeRevision mergeInto - addChild mergeInto baseRev - addChild mergeInto (coreRevision latestTarget) - - return mergeInto - - --------------------------------------------------------------------------------- -{-| Create an edit, and run an 'EditT' action to create the various components -of the edit (that is, link revisions to the edit). -} -createEdit :: EditT a -> MusicBrainz (Ref Edit) -createEdit actions = do - editId <- openEdit - runEditT editId actions - return editId - --------------------------------------------------------------------------------- -{-| Allow an editor to cast a 'Vote' on an edit. -} -voteOnEdit :: Ref Editor -> Ref Edit -> VoteScore -> MusicBrainz () -voteOnEdit editorId editId vote = void $ execute - [sql| INSERT INTO vote (edit_id, editor_id, vote) VALUES (?, ?, ?) |] - (editId, editorId, vote) - - --------------------------------------------------------------------------------- -{-| Append an edit note to the list of edit notes for an edit. -} -addEditNote :: Ref Edit -> EditNote -> MusicBrainz () -addEditNote editId note = void $ execute - [sql| INSERT INTO edit_note (edit_id, editor_id, text) VALUES (?, ?, ?) |] - (Only editId :. note) - - --------------------------------------------------------------------------------- -{-| Find all edit notes for an edit. -} -findEditNotes :: Ref Edit -> MusicBrainz [Entity EditNote] -findEditNotes editId = query - [sql| SELECT edit_note_id, text, editor_id FROM edit_note WHERE edit_id = ? |] - (Only editId) - - --------------------------------------------------------------------------------- -{-| A vote on an edit. -} -data Vote = Vote { voteVote :: !VoteScore - , voteEditor :: !(Ref Editor) - , voteSuperceded :: !Bool - } - deriving (Eq, Show) - -instance FromRow Vote where - fromRow = Vote <$> field <*> field <*> field - - --------------------------------------------------------------------------------- -{-| The possible types of votes that editors can cast on an edit. -} -data VoteScore = Accept | Reject | Abstain - deriving (Eq, Show) - --- A custom instance here allows us to use -1 for reject. -instance Enum VoteScore where - fromEnum Accept = 1 - fromEnum Reject = -1 - fromEnum Abstain = 0 - - toEnum 1 = Accept - toEnum (-1) = Reject - toEnum 0 = Abstain - toEnum n = error $ show n ++ " cannot be converted to Vote" - - enumFrom = boundedEnumFrom - -instance Bounded VoteScore where - minBound = Reject - maxBound = Accept - -instance FromField VoteScore where - fromField f v = toEnum <$> fromField f v - -instance ToField VoteScore where - toField = toField . fromEnum - - --------------------------------------------------------------------------------- -listVotes :: (Functor m, Monad m, MonadIO m) => Ref Edit -> MusicBrainzT m [Vote] -listVotes editId = - query [sql| - SELECT vote, editor_id, - row_number() OVER (PARTITION BY editor_id ORDER BY vote_time DESC) > 1 AS superceded - FROM vote - WHERE edit_id = ? - ORDER BY vote_time ASC - |] (Only editId) diff --git a/src/MusicBrainz/EditApplication.hs b/src/MusicBrainz/EditApplication.hs index e0d4565..7df3900 100644 --- a/src/MusicBrainz/EditApplication.hs +++ b/src/MusicBrainz/EditApplication.hs @@ -10,14 +10,12 @@ import Database.PostgreSQL.Simple.SqlQQ (sql) import MusicBrainz.Monad import MusicBrainz.Artist -import MusicBrainz.Edit import MusicBrainz.Label import MusicBrainz.Recording -import MusicBrainz.Ref import MusicBrainz.Release import MusicBrainz.ReleaseGroup -import MusicBrainz.Revision import MusicBrainz.URL +import MusicBrainz.Versioning import MusicBrainz.Work -------------------------------------------------------------------------------- diff --git a/src/MusicBrainz/Editor.hs b/src/MusicBrainz/Editor.hs deleted file mode 100644 index b6db7d0..0000000 --- a/src/MusicBrainz/Editor.hs +++ /dev/null @@ -1,67 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeFamilies #-} -module MusicBrainz.Editor where - -import Control.Applicative -import Control.Lens -import Data.Maybe (listToMaybe) -import Data.Text (Text) -import Database.PostgreSQL.Simple (Only(..)) -import Database.PostgreSQL.Simple.FromField (FromField(..)) -import Database.PostgreSQL.Simple.FromRow (FromRow(..), field) -import Database.PostgreSQL.Simple.SqlQQ (sql) -import Database.PostgreSQL.Simple.ToField (ToField(..)) -import Database.PostgreSQL.Simple.ToRow (ToRow(..)) - -import MusicBrainz.Monad -import MusicBrainz.Class.ResolveReference -import MusicBrainz.Entity -import MusicBrainz.Ref (Referenceable(..), Ref, reference, dereference) - --------------------------------------------------------------------------------- -{-| A MusicBrainz editor who makes changes to the database. -} -data Editor = Editor { editorName :: !Text - , editorPassword :: !Text - } - deriving (Eq, Show) - -instance Referenceable Editor where - type RefSpec Editor = Int - -instance FromField (Ref Editor) where - fromField f v = view reference <$> fromField f v - -instance FromRow Editor where - fromRow = Editor <$> field <*> field - -instance ToField (Ref Editor) where - toField = toField . dereference - -instance ToRow Editor where - toRow Editor{..} = [ toField editorName - , toField editorPassword - ] - -instance ResolveReference Editor where - resolveReference editorId = listToMaybe . map fromOnly <$> - query [sql| SELECT id FROM editor WHERE id = ? |] (Only editorId) - - --------------------------------------------------------------------------------- -{-| Look up an editor by their name. -} -findEditorByName :: Text -> MusicBrainz (Maybe (Entity Editor)) -findEditorByName name = - listToMaybe <$> query [sql| SELECT id, name, password FROM editor WHERE name = ? |] - (Only name) - - --------------------------------------------------------------------------------- -{-| Register a new MusicBrainz editor. -} -register :: Editor -> MusicBrainz (Entity Editor) -register editor = head <$> query - [sql| INSERT INTO editor (name, password) VALUES (?, ?) - RETURNING id, name, password |] editor - diff --git a/src/MusicBrainz/Entity.hs b/src/MusicBrainz/Entity.hs deleted file mode 100644 index 6043295..0000000 --- a/src/MusicBrainz/Entity.hs +++ /dev/null @@ -1,60 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE UndecidableInstances #-} -module MusicBrainz.Entity where - -import Control.Applicative -import Control.Monad.IO.Class (MonadIO) -import Database.PostgreSQL.Simple.FromField (FromField) -import Database.PostgreSQL.Simple.FromRow (FromRow(..), field) - -import MusicBrainz.Monad -import MusicBrainz.Ref (Ref) -import {-# SOURCE #-} MusicBrainz.Revision (Revision) - --------------------------------------------------------------------------------- -{-| An 'Entity' is something that has been loaded from the database. It cotains -both data about itself (in @entityData@), and also a reference to itself (in -@entityRef@) so that other data/entities can refer to it. -} -data Entity a = Entity { entityRef :: !(Ref a) - , entityData :: !a - } - -deriving instance (Eq a, Show a) => Eq (Entity a) -deriving instance (Eq a, Show a) => Show (Entity a) - -instance (FromField (Ref a), FromRow a) => FromRow (Entity a) where - fromRow = Entity -- Entity reference - <$> field - -- Delegetate to the actual entity to parse its data. - <*> fromRow - - --------------------------------------------------------------------------------- -{-| Represents a view of a versioned MusicBrainz \'core\' entity at a specific -point in time (a specific 'Revision'). -} -data CoreEntity a = CoreEntity - { coreRef :: !(Ref a) - , coreRevision :: !(Ref (Revision a)) - , coreData :: !a - } - -deriving instance (Eq a, Show a) => Eq (CoreEntity a) -deriving instance (Eq a, Show a) => Show (CoreEntity a) - -instance (FromField (Ref a), FromRow a) => FromRow (CoreEntity a) where - fromRow = CoreEntity -- Core entity's MBID - <$> field - -- The revision reference - <*> field - -- Delegetate to the actual entity to parse its data. - <*> fromRow - - --------------------------------------------------------------------------------- -{-| The 'Add' type class allows you to add new entities that are not -versioned. -} -class Add a where - {-| Add a new entity, with some starting data, producing a fresh 'Entity' - with a 'Ref'. -} - add :: (Functor m, MonadIO m) => a -> MusicBrainzT m (Entity a) diff --git a/src/MusicBrainz/Gender.hs b/src/MusicBrainz/Gender.hs index 8329e34..82b3d9e 100644 --- a/src/MusicBrainz/Gender.hs +++ b/src/MusicBrainz/Gender.hs @@ -17,9 +17,7 @@ import Database.PostgreSQL.Simple.ToField (ToField(..)) import Database.PostgreSQL.Simple.ToRow (ToRow(..)) import MusicBrainz.Monad -import MusicBrainz.Class.ResolveReference -import MusicBrainz.Entity -import MusicBrainz.Ref (Referenceable(..), Ref, reference, dereference) +import MusicBrainz.Versioning -------------------------------------------------------------------------------- {-| The gender of an artist or editor. -} diff --git a/src/MusicBrainz/Generic.hs b/src/MusicBrainz/Generic.hs index a40dd08..e28c7fd 100644 --- a/src/MusicBrainz/Generic.hs +++ b/src/MusicBrainz/Generic.hs @@ -30,12 +30,12 @@ import qualified Data.Set as Set import MusicBrainz.Util (viewOnce) import MusicBrainz.Monad -import MusicBrainz.Edit -import MusicBrainz.Editor -import MusicBrainz.Entity -import MusicBrainz.Ref import MusicBrainz.Relationship -import MusicBrainz.Tree +import MusicBrainz.Versioning hiding (findLatest) +import MusicBrainz.Alias +import MusicBrainz.IPI +import MusicBrainz.ISNI +import MusicBrainz.Relationship.Internal hiding (reflectRelationshipChange) import MusicBrainz.Artist () import MusicBrainz.Label () @@ -45,7 +45,7 @@ import MusicBrainz.ReleaseGroup () import MusicBrainz.URL () import MusicBrainz.Work () -import qualified MusicBrainz.Class.FindLatest as MB +import qualified MusicBrainz.Versioning as MB -------------------------------------------------------------------------------- realiseAliases :: (Functor m, MonadIO m, TreeAliases a) => String -> Ref (Tree a) -> Tree a -> MusicBrainzT m () diff --git a/src/MusicBrainz/Generic.hs-boot b/src/MusicBrainz/Generic.hs-boot index b508a03..269d774 100644 --- a/src/MusicBrainz/Generic.hs-boot +++ b/src/MusicBrainz/Generic.hs-boot @@ -22,14 +22,14 @@ import qualified Data.Map as Map import qualified Data.Set as Set import MusicBrainz.Monad -import MusicBrainz.Edit -import MusicBrainz.Editor -import MusicBrainz.Entity -import MusicBrainz.Ref -import MusicBrainz.Relationship -import MusicBrainz.Tree - -import qualified MusicBrainz.Class.FindLatest as MB +import MusicBrainz.Alias +import MusicBrainz.IPI +import MusicBrainz.ISNI +import MusicBrainz.Versioning hiding (findLatest) +import MusicBrainz.Relationship +import MusicBrainz.Relationship.Internal hiding (reflectRelationshipChange) + +import qualified MusicBrainz.Versioning as MB realiseAliases :: (Functor m, MonadIO m, TreeAliases a) => String -> Ref (Tree a) -> Tree a -> MusicBrainzT m () diff --git a/src/MusicBrainz/IPI.hs b/src/MusicBrainz/IPI.hs index a9258a8..a14f5dd 100644 --- a/src/MusicBrainz/IPI.hs +++ b/src/MusicBrainz/IPI.hs @@ -6,6 +6,7 @@ module MusicBrainz.IPI where import Control.Applicative import Control.Lens import Control.Monad.IO.Class (MonadIO) +import Data.Set (Set) import Data.String (fromString) import Data.Tagged (Tagged, untag) import Data.Text (Text) @@ -15,13 +16,6 @@ import Database.PostgreSQL.Simple.FromField (FromField(..)) import Database.PostgreSQL.Simple.FromRow (FromRow(..), field) import Database.PostgreSQL.Simple.ToField (toField) import Database.PostgreSQL.Simple.ToRow (ToRow(..)) - -import MusicBrainz.Monad -import MusicBrainz.Class.RootTable -import MusicBrainz.Lens (fieldFromPrism, parsecPrism) -import MusicBrainz.Ref (Ref) -import MusicBrainz.Revision (Revision) -import MusicBrainz.Util (groupMap) import Text.Parsec hiding ((<|>)) import Text.Parsec.Text () @@ -29,6 +23,13 @@ import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.Text as T +import MusicBrainz.Monad +import MusicBrainz.Class.RootTable +import MusicBrainz.Lens (fieldFromPrism, parsecPrism) +import MusicBrainz.Util (groupMap) +import MusicBrainz.Versioning + + -------------------------------------------------------------------------------- {-| An \'Interested Parties Information Code\' that can be attached to various entities. -} @@ -80,3 +81,10 @@ class ViewIPICodes a where , "JOIN " ++ entityName ++ "_revision USING (" ++ entityName ++ "_tree_id) " , "WHERE revision_id = ?" ] + + +-------------------------------------------------------------------------------- +{-| Provide a single lens to view the IPI codes inside a 'Tree'. -} +class TreeIPICodes a where + {-| A 'Lens' into the annotation for any 'Tree'. -} + ipiCodes :: Lens' (Tree a) (Set IPI) diff --git a/src/MusicBrainz/ISNI.hs b/src/MusicBrainz/ISNI.hs index fa6430d..8e9f57e 100644 --- a/src/MusicBrainz/ISNI.hs +++ b/src/MusicBrainz/ISNI.hs @@ -8,6 +8,7 @@ import Control.Applicative import Control.Lens import Control.Monad.IO.Class (MonadIO) import Data.Monoid (mconcat) +import Data.Set (Set) import Data.String (fromString) import Data.Tagged (Tagged, untag) import Data.Text (Text) @@ -19,16 +20,15 @@ import Database.PostgreSQL.Simple.ToRow (ToRow(..)) import Text.Parsec hiding ((<|>)) import Text.Parsec.Text () +import qualified Data.Map as Map +import qualified Data.Set as Set +import qualified Data.Text as T + import MusicBrainz.Monad import MusicBrainz.Class.RootTable import MusicBrainz.Lens (fieldFromPrism, parsecPrism) -import MusicBrainz.Ref (Ref) -import MusicBrainz.Revision (Revision) import MusicBrainz.Util (groupMap) - -import qualified Data.Map as Map -import qualified Data.Set as Set -import qualified Data.Text as T +import MusicBrainz.Versioning -------------------------------------------------------------------------------- {-| An \'International Standard Name Identifier\' that can be attached to various @@ -77,3 +77,10 @@ class ViewISNICodes a where , "JOIN " ++ entityName ++ "_revision USING (" ++ entityName ++ "_tree_id) " , "WHERE revision_id = ?" ] + + +-------------------------------------------------------------------------------- +{-| Provide a single lens to view the ISNI codes inside a 'Tree'. -} +class TreeISNICodes a where + {-| A 'Lens' into the annotation for any 'Tree'. -} + isniCodes :: Lens' (Tree a) (Set ISNI) diff --git a/src/MusicBrainz/Label.hs b/src/MusicBrainz/Label.hs index fe03a53..b46fb92 100644 --- a/src/MusicBrainz/Label.hs +++ b/src/MusicBrainz/Label.hs @@ -27,28 +27,16 @@ import MusicBrainz.Merge import MusicBrainz.Monad import MusicBrainz.Alias import MusicBrainz.Annotation -import MusicBrainz.Class.Create -import MusicBrainz.Class.FindLatest -import MusicBrainz.Class.MasterRevision -import MusicBrainz.Class.NewEntityRevision -import MusicBrainz.Class.RealiseTree -import MusicBrainz.Class.ResolveReference import MusicBrainz.Class.RootTable import MusicBrainz.Class.Update -import MusicBrainz.Class.ViewRevision import MusicBrainz.Country (Country) -import MusicBrainz.Edit (Editable(..)) -import MusicBrainz.Entity (Add(..), coreData) import MusicBrainz.IPI import MusicBrainz.ISNI import MusicBrainz.MBID (MBID) import MusicBrainz.PartialDate (PartialDate) -import MusicBrainz.Ref (Ref, Referenceable(..), reference, dereference) import MusicBrainz.Relationship -import MusicBrainz.Relationship.Internal (HoldsRelationships(..), viewRelationships) -import MusicBrainz.Revision (Revision) -import MusicBrainz.Revision.Internal (CloneRevision(..)) -import MusicBrainz.Tree +import MusicBrainz.Relationship.Internal +import MusicBrainz.Versioning hiding (merge) import {-# SOURCE #-} qualified MusicBrainz.Generic as Generic diff --git a/src/MusicBrainz/Label.hs-boot b/src/MusicBrainz/Label.hs-boot index 1c241e5..f6adc59 100644 --- a/src/MusicBrainz/Label.hs-boot +++ b/src/MusicBrainz/Label.hs-boot @@ -2,7 +2,7 @@ module MusicBrainz.Label where import Database.PostgreSQL.Simple.FromField (FromField) -import MusicBrainz.Ref (Ref) +import MusicBrainz.Versioning data Label diff --git a/src/MusicBrainz/Language.hs b/src/MusicBrainz/Language.hs index 3336261..7a81540 100644 --- a/src/MusicBrainz/Language.hs +++ b/src/MusicBrainz/Language.hs @@ -17,9 +17,7 @@ import Database.PostgreSQL.Simple.ToField (ToField(..)) import Database.PostgreSQL.Simple.ToRow (ToRow(..)) import MusicBrainz.Monad -import MusicBrainz.Class.ResolveReference -import MusicBrainz.Entity (Add(..)) -import MusicBrainz.Ref (Referenceable(..), Ref, reference, dereference) +import MusicBrainz.Versioning -------------------------------------------------------------------------------- {-| A language that is written or spoken. -} diff --git a/src/MusicBrainz/Recording.hs b/src/MusicBrainz/Recording.hs index 25e6c58..acc9ccf 100644 --- a/src/MusicBrainz/Recording.hs +++ b/src/MusicBrainz/Recording.hs @@ -27,25 +27,13 @@ import MusicBrainz.Monad import MusicBrainz.Artist import MusicBrainz.ArtistCredit import MusicBrainz.Annotation -import MusicBrainz.Class.Create -import MusicBrainz.Class.FindLatest -import MusicBrainz.Class.MasterRevision -import MusicBrainz.Class.NewEntityRevision -import MusicBrainz.Class.RealiseTree -import MusicBrainz.Class.ResolveReference import MusicBrainz.Class.RootTable import MusicBrainz.Class.Update -import MusicBrainz.Class.ViewRevision -import MusicBrainz.Edit (Editable(..)) -import MusicBrainz.Entity import MusicBrainz.ISRC import MusicBrainz.MBID (MBID) -import MusicBrainz.Ref (Ref, Referenceable(..), reference, dereference) import MusicBrainz.Relationship -import MusicBrainz.Relationship.Internal (HoldsRelationships(..), viewRelationships) -import MusicBrainz.Revision (Revision) -import MusicBrainz.Revision.Internal (CloneRevision(..)) -import MusicBrainz.Tree +import MusicBrainz.Relationship.Internal +import MusicBrainz.Versioning hiding (merge) import {-# SOURCE #-} MusicBrainz.Release import {-# SOURCE #-} qualified MusicBrainz.Generic as Generic diff --git a/src/MusicBrainz/Recording.hs-boot b/src/MusicBrainz/Recording.hs-boot index 6e8f11f..f5e4000 100644 --- a/src/MusicBrainz/Recording.hs-boot +++ b/src/MusicBrainz/Recording.hs-boot @@ -2,7 +2,7 @@ module MusicBrainz.Recording where import Database.PostgreSQL.Simple.FromField (FromField) -import MusicBrainz.Ref (Ref) +import MusicBrainz.Versioning data Recording diff --git a/src/MusicBrainz/Ref.hs b/src/MusicBrainz/Ref.hs deleted file mode 100644 index b913194..0000000 --- a/src/MusicBrainz/Ref.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeFamilies #-} -module MusicBrainz.Ref where - -import Control.Lens - --------------------------------------------------------------------------------- -{-| A reference to a specific entity. In the database, this a foreign key -relationship to an entity of type @a@. -} -data Ref a = Referenceable a => Ref !(RefSpec a) - -deriving instance Eq (Ref a) -deriving instance Ord (Ref a) -deriving instance Show (Ref a) - -{-| The family of types which can be referenced via a primary key. -} -class (Eq (RefSpec a), Ord (RefSpec a), Show (RefSpec a)) => Referenceable a where - {-| The exact type of all attributes that make up a reference. For example, - a PostgreSQL @SERIAL@ field would be 'Int', while a compound key might be - @(@'Int'@, @'Int'). -} - type RefSpec a :: * - --------------------------------------------------------------------------------- -{-| Unpack a reference into its individual attributes. -} -dereference :: Referenceable a => Ref a -> RefSpec a -dereference = view (from reference) - - --------------------------------------------------------------------------------- -{-| An 'Iso'morphism to move between a set of attributes and a reference, and -back again. -} -reference :: Referenceable a => Iso' (RefSpec a) (Ref a) -reference = iso Ref (\(Ref r) -> r) diff --git a/src/MusicBrainz/Relationship.hs b/src/MusicBrainz/Relationship.hs index 2f4cb67..581d2e0 100644 --- a/src/MusicBrainz/Relationship.hs +++ b/src/MusicBrainz/Relationship.hs @@ -21,10 +21,8 @@ import Database.PostgreSQL.Simple.ToField (ToField(..)) import Database.PostgreSQL.Simple.ToRow (ToRow(..)) import MusicBrainz.Monad -import MusicBrainz.Class.ResolveReference -import MusicBrainz.Entity import MusicBrainz.PartialDate (PartialDate) -import MusicBrainz.Ref (Ref, Referenceable(..), reference, dereference) +import MusicBrainz.Versioning import {-# SOURCE #-} MusicBrainz.Artist (Artist) import {-# SOURCE #-} MusicBrainz.Label (Label) @@ -264,4 +262,3 @@ data LinkedRelationship | URLRelationship !(Ref URL) !Relationship | WorkRelationship !(Ref Work) !Relationship deriving (Eq, Ord, Show) - diff --git a/src/MusicBrainz/Relationship/Internal.hs b/src/MusicBrainz/Relationship/Internal.hs index 8fd3c76..9319a9e 100644 --- a/src/MusicBrainz/Relationship/Internal.hs +++ b/src/MusicBrainz/Relationship/Internal.hs @@ -2,11 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} -module MusicBrainz.Relationship.Internal - ( HoldsRelationships(..) - , reflectRelationshipChanges - , viewRelationships - ) where +module MusicBrainz.Relationship.Internal where import Control.Applicative import Control.Lens hiding (cons) @@ -25,15 +21,9 @@ import qualified Data.Set as Set import MusicBrainz.Monad import MusicBrainz.Class.RootTable -import MusicBrainz.Class.ViewRevision -import MusicBrainz.Edit -import MusicBrainz.Editor -import MusicBrainz.Entity import MusicBrainz.PartialDate -import MusicBrainz.Ref (Ref) -import MusicBrainz.Revision (Revision) -import {-# SOURCE #-} MusicBrainz.Tree (Tree, TreeRelationships, relationships) import MusicBrainz.Relationship +import MusicBrainz.Versioning import {-# SOURCE #-} MusicBrainz.Artist () @@ -148,3 +138,9 @@ inflateRelationships relationshipIds = do } in (relId, relationship) + +-------------------------------------------------------------------------------- +{-| Provide a single lens to view all relationships inside a 'Tree'. -} +class TreeRelationships a where + {-| A 'Lens' into all relationships for any 'Tree'. -} + relationships :: Lens' (Tree a) (Set LinkedRelationship) diff --git a/src/MusicBrainz/Release.hs b/src/MusicBrainz/Release.hs index 24adbf8..58eeed3 100644 --- a/src/MusicBrainz/Release.hs +++ b/src/MusicBrainz/Release.hs @@ -33,32 +33,20 @@ import MusicBrainz.Monad import MusicBrainz.Annotation import MusicBrainz.Artist import MusicBrainz.ArtistCredit (ArtistCredit) -import MusicBrainz.Class.Create -import MusicBrainz.Class.FindLatest -import MusicBrainz.Class.MasterRevision -import MusicBrainz.Class.NewEntityRevision -import MusicBrainz.Class.RealiseTree -import MusicBrainz.Class.ResolveReference import MusicBrainz.Class.RootTable import MusicBrainz.Class.Update -import MusicBrainz.Class.ViewRevision import MusicBrainz.Country (Country) -import MusicBrainz.Edit (Editable(..)) -import MusicBrainz.Entity import MusicBrainz.Label (Label) import MusicBrainz.Language (Language) import MusicBrainz.Lens (fieldFromPrism) import MusicBrainz.MBID (MBID) import MusicBrainz.PartialDate (PartialDate) import MusicBrainz.Recording (Recording) -import MusicBrainz.Ref (Ref, Referenceable(..), reference, dereference) import MusicBrainz.Relationship -import MusicBrainz.Relationship.Internal (HoldsRelationships(..), viewRelationships) +import MusicBrainz.Relationship.Internal import MusicBrainz.ReleaseGroup (ReleaseGroup) -import MusicBrainz.Revision (Revision) -import MusicBrainz.Revision.Internal (CloneRevision(..)) import MusicBrainz.Script (Script) -import MusicBrainz.Tree +import MusicBrainz.Versioning hiding (merge) import {-# SOURCE #-} qualified MusicBrainz.Generic as Generic diff --git a/src/MusicBrainz/Release.hs-boot b/src/MusicBrainz/Release.hs-boot index 737dd14..e671a25 100644 --- a/src/MusicBrainz/Release.hs-boot +++ b/src/MusicBrainz/Release.hs-boot @@ -3,7 +3,7 @@ module MusicBrainz.Release where import Database.PostgreSQL.Simple.FromField (FromField) import Database.PostgreSQL.Simple.FromRow (FromRow) -import MusicBrainz.Ref (Ref) +import MusicBrainz.Versioning data Release instance Eq Release diff --git a/src/MusicBrainz/ReleaseGroup.hs b/src/MusicBrainz/ReleaseGroup.hs index 041e251..361afdc 100644 --- a/src/MusicBrainz/ReleaseGroup.hs +++ b/src/MusicBrainz/ReleaseGroup.hs @@ -28,24 +28,12 @@ import MusicBrainz.Monad import MusicBrainz.Annotation import MusicBrainz.Artist import MusicBrainz.ArtistCredit (ArtistCredit) -import MusicBrainz.Class.Create -import MusicBrainz.Class.FindLatest -import MusicBrainz.Class.MasterRevision -import MusicBrainz.Class.NewEntityRevision -import MusicBrainz.Class.RealiseTree -import MusicBrainz.Class.ResolveReference import MusicBrainz.Class.RootTable import MusicBrainz.Class.Update -import MusicBrainz.Class.ViewRevision -import MusicBrainz.Edit (Editable(..)) -import MusicBrainz.Entity import MusicBrainz.MBID (MBID) -import MusicBrainz.Ref (Ref, Referenceable(..), reference, dereference) import MusicBrainz.Relationship -import MusicBrainz.Relationship.Internal (HoldsRelationships(..), viewRelationships) -import MusicBrainz.Revision (Revision) -import MusicBrainz.Revision.Internal (CloneRevision(..)) -import MusicBrainz.Tree +import MusicBrainz.Relationship.Internal +import MusicBrainz.Versioning hiding (merge) import qualified Data.Set as Set diff --git a/src/MusicBrainz/ReleaseGroup.hs-boot b/src/MusicBrainz/ReleaseGroup.hs-boot index f6d8700..cf28041 100644 --- a/src/MusicBrainz/ReleaseGroup.hs-boot +++ b/src/MusicBrainz/ReleaseGroup.hs-boot @@ -2,7 +2,7 @@ module MusicBrainz.ReleaseGroup where import Database.PostgreSQL.Simple.FromField (FromField) -import MusicBrainz.Ref (Ref) +import MusicBrainz.Versioning data ReleaseGroup diff --git a/src/MusicBrainz/Revision.hs b/src/MusicBrainz/Revision.hs deleted file mode 100644 index 25994dd..0000000 --- a/src/MusicBrainz/Revision.hs +++ /dev/null @@ -1,96 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TypeFamilies #-} -module MusicBrainz.Revision where - -import Control.Applicative -import Control.Lens -import Control.Monad.IO.Class (MonadIO) -import Data.Maybe (listToMaybe) -import Data.Time (UTCTime) -import Database.PostgreSQL.Simple (In(..), Only(..)) -import Database.PostgreSQL.Simple.FromField (FromField(..)) -import Database.PostgreSQL.Simple.FromRow (FromRow(..), field) -import Database.PostgreSQL.Simple.SqlQQ (sql) -import Database.PostgreSQL.Simple.ToField (ToField(..)) - -import MusicBrainz.Monad -import MusicBrainz.Class.GetEntity -import MusicBrainz.Ref (Ref, Referenceable(..), reference, dereference) - -import qualified Data.Set as Set - --------------------------------------------------------------------------------- -{-| A revision is a version of an entity at a specific point in time. The type -@a@ indicates what type of entity this is a revision of (e.g., @Revision Artist@ -means a specific revision of an 'Artist'). -} -data Revision a = Revision { revisionCreatedAt :: !UTCTime } - deriving (Eq, Show) - -instance Referenceable (Revision a) where - type RefSpec (Revision a) = Int - -instance FromField (Ref (Revision a)) where - fromField f v = view reference <$> fromField f v - -instance FromRow (Revision a) where - fromRow = Revision <$> field - -instance ToField (Ref (Revision a)) where - toField = toField . dereference - - --------------------------------------------------------------------------------- -{-| Attempt to resolve a the revision which 2 revisions forked from. -} -mergeBase :: (Functor m, MonadIO m) => Ref (Revision a) -> Ref (Revision a) - -> MusicBrainzT m (Maybe (Ref (Revision a))) -mergeBase a b = listToMaybe . map fromOnly <$> query - [sql| WITH RECURSIVE revision_path (revision_id, parent_revision_id, distance) - AS ( - SELECT revision_id, parent_revision_id, 1 - FROM revision_parent - WHERE revision_id IN ? - - UNION - - SELECT - revision_path.revision_id, revision_parent.parent_revision_id, - distance + 1 - FROM revision_parent - JOIN revision_path - ON (revision_parent.revision_id = revision_path.parent_revision_id) - ) - SELECT parent_revision_id - FROM revision_path a - JOIN revision_path b USING (parent_revision_id) - ORDER BY a.distance, b.distance - LIMIT 1 |] (Only $ In [a, b]) - - - --------------------------------------------------------------------------------- -{-| Find references to the parent revisions of a given revision. -} -revisionParents :: (Functor m, MonadIO m) - => Ref (Revision a) -> MusicBrainzT m (Set.Set (Ref (Revision a))) -revisionParents r = - Set.fromList . map fromOnly <$> query q (Only r) - where q = [sql| SELECT parent_revision_id FROM revision_parent - WHERE revision_id = ? |] - - --------------------------------------------------------------------------------- -revisionChildren :: (Functor m, MonadIO m) - => Ref (Revision a) -> MusicBrainzT m (Set.Set (Ref (Revision a))) -revisionChildren r = - Set.fromList . map fromOnly <$> query q (Only r) - where q = [sql| SELECT revision_id FROM revision_parent - WHERE parent_revision_id = ? |] - - --------------------------------------------------------------------------------- -instance GetEntity (Revision a) where - getEntity r = head <$> - query [sql| SELECT revision_id, created_at - FROM revision - WHERE revision_id = ? |] (Only r) diff --git a/src/MusicBrainz/Revision/Internal.hs b/src/MusicBrainz/Revision/Internal.hs deleted file mode 100644 index c516050..0000000 --- a/src/MusicBrainz/Revision/Internal.hs +++ /dev/null @@ -1,81 +0,0 @@ -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE ScopedTypeVariables #-} -module MusicBrainz.Revision.Internal - ( newUnlinkedRevision - , addChild - , newChildRevision - , CloneRevision(..) - ) where - -import Control.Monad (void) -import Control.Monad.IO.Class (MonadIO) -import Database.PostgreSQL.Simple (Only(..)) -import Database.PostgreSQL.Simple.SqlQQ (sql) -import Database.PostgreSQL.Simple.ToField (ToField) -import Data.Tagged (Tagged, untag) -import Data.String (fromString) - -import MusicBrainz.Monad -import MusicBrainz.Class.NewEntityRevision -import MusicBrainz.Class.RootTable (RootTable(..)) -import MusicBrainz.Class.ViewRevision -import MusicBrainz.Editor (Editor) -import MusicBrainz.Entity -import MusicBrainz.Ref (Ref) -import MusicBrainz.Revision (Revision) -import MusicBrainz.Tree (Tree) - --------------------------------------------------------------------------------- -{-| Create a new \'system\' revision, that is not yet bound to any entity. -} -newUnlinkedRevision :: (Functor m, MonadIO m) - => Ref Editor -> MusicBrainzT m (Ref (Revision a)) -newUnlinkedRevision editor = selectValue $ - query [sql| INSERT INTO revision (editor_id) VALUES (?) RETURNING revision_id |] - (Only editor) - - --------------------------------------------------------------------------------- -{-| Add one 'Revision' as a child of another (parent) 'Revision'. -} -addChild :: (Functor m, MonadIO m) => Ref (Revision a) -> Ref (Revision a) -> MusicBrainzT m () -addChild childRevision parentRevision = - void $ execute - [sql| INSERT INTO revision_parent (revision_id, parent_revision_id) - VALUES (?, ?) |] (childRevision, parentRevision) - - --------------------------------------------------------------------------------- -class CloneRevision a where - cloneRevision :: (Functor m, MonadIO m) - => CoreEntity a -> Ref Editor -> MusicBrainzT m (Ref (Revision a)) - - default cloneRevision - :: (Functor m, MonadIO m, ToField (Ref a), RootTable a) - => CoreEntity a -> Ref Editor -> MusicBrainzT m (Ref (Revision a)) - cloneRevision a editor = do - revId <- newUnlinkedRevision editor - selectValue $ query q (coreRef a, revId, coreRevision a) - - where - - entityName = untag (rootTable :: Tagged a String) - q = fromString $ unlines - [ "INSERT INTO " ++ entityName ++ "_revision (" ++ entityName ++ "_id, revision_id, " ++ entityName ++ "_tree_id) " - , "VALUES (?, ?, (SELECT " ++ entityName ++ "_tree_id FROM " ++ entityName ++ "_revision WHERE revision_id = ?)) " - , "RETURNING revision_id" - ] - - - --------------------------------------------------------------------------------- -newChildRevision :: (Functor m, MonadIO m, ViewRevision a, NewEntityRevision a) - => Ref Editor -> Ref (Revision a) -> Ref (Tree a) - -> MusicBrainzT m (Ref (Revision a)) -newChildRevision editorId baseRevisionId treeId = do - entity <- viewRevision baseRevisionId - revisionId <- newUnlinkedRevision editorId - newEntityRevision revisionId (coreRef entity) treeId - addChild revisionId baseRevisionId - return revisionId diff --git a/src/MusicBrainz/Script.hs b/src/MusicBrainz/Script.hs index aa3247b..cdf9551 100644 --- a/src/MusicBrainz/Script.hs +++ b/src/MusicBrainz/Script.hs @@ -17,9 +17,7 @@ import Database.PostgreSQL.Simple.ToField (ToField(..)) import Database.PostgreSQL.Simple.ToRow (ToRow(..)) import MusicBrainz.Monad -import MusicBrainz.Class.ResolveReference -import MusicBrainz.Entity -import MusicBrainz.Ref (Ref, Referenceable(..), reference, dereference) +import MusicBrainz.Versioning -------------------------------------------------------------------------------- {-| The script that text is written. -} diff --git a/src/MusicBrainz/Tree.hs b/src/MusicBrainz/Tree.hs deleted file mode 100644 index 543cc15..0000000 --- a/src/MusicBrainz/Tree.hs +++ /dev/null @@ -1,75 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeFamilies #-} -module MusicBrainz.Tree where - -import Control.Applicative -import Control.Lens -import Control.Monad.IO.Class (MonadIO) -import Data.Set (Set) -import Data.Text (Text) -import Database.PostgreSQL.Simple.FromField (FromField(..)) -import Database.PostgreSQL.Simple.ToField (ToField(..)) - -import MusicBrainz.Monad -import MusicBrainz.Alias -import MusicBrainz.IPI -import MusicBrainz.ISNI -import MusicBrainz.Ref (Ref, Referenceable(..), reference, dereference) -import MusicBrainz.Relationship (LinkedRelationship) -import MusicBrainz.Revision (Revision) - --------------------------------------------------------------------------------- -{-| Trees for entities are a somewhat internal concept of the way MusicBrainz -versioning works. A tree consists of all the data that is versioned for a -specific entity (of type @a@). -} -class HasTree a where - data Tree a :: * - - {-| A convenience accessor to the \'essential\' data inside a tree (the data - which contains the entities, and so on.) -} - treeData :: Tree a -> a - -instance Referenceable (Tree a) where - type RefSpec (Tree a) = Int - -instance FromField (Ref (Tree a)) where - fromField f v = view reference <$> fromField f v - -instance ToField (Ref (Tree a)) where - toField = toField . dereference - --------------------------------------------------------------------------------- -{-| Provide a single lens to view all relationships inside a 'Tree'. -} -class TreeRelationships a where - {-| A 'Lens' into all relationships for any 'Tree'. -} - relationships :: Lens' (Tree a) (Set LinkedRelationship) - --------------------------------------------------------------------------------- -{-| View all data about a specific version of an entity. -} -class ViewTree a where - viewTree :: (Applicative m, MonadIO m) - => Ref (Revision a) -> MusicBrainzT m (Tree a) - --------------------------------------------------------------------------------- -{-| Provide a single lens to view the IPI codes inside a 'Tree'. -} -class TreeIPICodes a where - {-| A 'Lens' into the annotation for any 'Tree'. -} - ipiCodes :: Lens' (Tree a) (Set IPI) - --------------------------------------------------------------------------------- -{-| Provide a single lens to view the ISNI codes inside a 'Tree'. -} -class TreeISNICodes a where - {-| A 'Lens' into the annotation for any 'Tree'. -} - isniCodes :: Lens' (Tree a) (Set ISNI) - --------------------------------------------------------------------------------- -{-| Provide a single lens to view the annotation inside a 'Tree'. -} -class TreeAnnotation a where - {-| A 'Lens' into the annotation for any 'Tree'. -} - annotation :: Lens' (Tree a) Text - --------------------------------------------------------------------------------- -{-| Provide a single lens to view all aliases inside a 'Tree'. -} -class TreeAliases a where - {-| A 'Lens' into all aliases for any 'Tree'. -} - aliases :: Lens' (Tree a) (Set (Alias a)) diff --git a/src/MusicBrainz/Tree.hs-boot b/src/MusicBrainz/Tree.hs-boot index 131c365..c77d109 100644 --- a/src/MusicBrainz/Tree.hs-boot +++ b/src/MusicBrainz/Tree.hs-boot @@ -4,8 +4,8 @@ module MusicBrainz.Tree (Tree, TreeRelationships(..)) where import Control.Lens import Data.Set (Set) import Database.PostgreSQL.Simple.ToField (ToField) -import MusicBrainz.Ref (Ref) import MusicBrainz.Relationship (LinkedRelationship) +import MusicBrainz.Versioning data Tree a diff --git a/src/MusicBrainz/URL.hs b/src/MusicBrainz/URL.hs index cbe0552..1efa9c9 100644 --- a/src/MusicBrainz/URL.hs +++ b/src/MusicBrainz/URL.hs @@ -25,24 +25,12 @@ import qualified Data.Set as Set import MusicBrainz.Merge import MusicBrainz.Monad -import MusicBrainz.Class.Create -import MusicBrainz.Class.FindLatest -import MusicBrainz.Class.MasterRevision -import MusicBrainz.Class.NewEntityRevision -import MusicBrainz.Class.RealiseTree -import MusicBrainz.Class.ResolveReference import MusicBrainz.Class.RootTable import MusicBrainz.Class.Update -import MusicBrainz.Class.ViewRevision -import MusicBrainz.Edit (Editable(..)) -import MusicBrainz.Entity (coreData) import MusicBrainz.MBID (MBID) -import MusicBrainz.Ref (Ref, Referenceable(..), reference, dereference) import MusicBrainz.Relationship -import MusicBrainz.Relationship.Internal (HoldsRelationships(..), viewRelationships) -import MusicBrainz.Revision (Revision) -import MusicBrainz.Revision.Internal (CloneRevision(..)) -import MusicBrainz.Tree +import MusicBrainz.Relationship.Internal +import MusicBrainz.Versioning hiding (merge) import {-# SOURCE #-} qualified MusicBrainz.Generic as Generic diff --git a/src/MusicBrainz/URL.hs-boot b/src/MusicBrainz/URL.hs-boot index 51c55ae..01d81c4 100644 --- a/src/MusicBrainz/URL.hs-boot +++ b/src/MusicBrainz/URL.hs-boot @@ -2,7 +2,7 @@ module MusicBrainz.URL where import Database.PostgreSQL.Simple.FromField (FromField) -import MusicBrainz.Ref (Ref) +import MusicBrainz.Versioning data URL diff --git a/src/MusicBrainz/Versioning.hs b/src/MusicBrainz/Versioning.hs new file mode 100644 index 0000000..65e9f48 --- /dev/null +++ b/src/MusicBrainz/Versioning.hs @@ -0,0 +1,774 @@ +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +module MusicBrainz.Versioning where + +import Control.Applicative +import Control.Lens +import Control.Monad (void) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Trans (lift) +import Control.Monad.Trans.Writer (WriterT(..), tell) +import Data.Maybe (listToMaybe) +import Data.String (fromString) +import Data.Tagged +import Data.Text (Text) +import Data.Time (UTCTime) +import Database.PostgreSQL.Simple (In(..), Only(..), (:.)(..)) +import Database.PostgreSQL.Simple.FromField (FromField(..)) +import Database.PostgreSQL.Simple.FromRow (FromRow(..), field) +import Database.PostgreSQL.Simple.SqlQQ (sql) +import Database.PostgreSQL.Simple.ToField (ToField(..)) +import Database.PostgreSQL.Simple.ToRow (ToRow(..)) +import GHC.Enum (boundedEnumFrom) + +import qualified Data.Map as Map +import qualified Data.Set as Set + +import MusicBrainz.Class.RootTable +import MusicBrainz.MBID +import MusicBrainz.Merge +import MusicBrainz.Monad +import MusicBrainz.Util (viewOnce) + + +-------------------------------------------------------------------------------- +{-| A reference to a specific entity. In the database, this a foreign key +relationship to an entity of type @a@. -} +data Ref a = Referenceable a => Ref !(RefSpec a) + +deriving instance Eq (Ref a) +deriving instance Ord (Ref a) +deriving instance Show (Ref a) + +{-| The family of types which can be referenced via a primary key. -} +class (Eq (RefSpec a), Ord (RefSpec a), Show (RefSpec a)) => Referenceable a where + {-| The exact type of all attributes that make up a reference. For example, + a PostgreSQL @SERIAL@ field would be 'Int', while a compound key might be + @(@'Int'@, @'Int'). -} + type RefSpec a :: * + + +-------------------------------------------------------------------------------- +{-| Unpack a reference into its individual attributes. -} +dereference :: Referenceable a => Ref a -> RefSpec a +dereference = view (from reference) + + +-------------------------------------------------------------------------------- +{-| An 'Iso'morphism to move between a set of attributes and a reference, and +back again. -} +reference :: Referenceable a => Iso' (RefSpec a) (Ref a) +reference = iso Ref (\(Ref r) -> r) + + +-------------------------------------------------------------------------------- +{-| An 'Entity' is something that has been loaded from the database. It cotains +both data about itself (in @entityData@), and also a reference to itself (in +@entityRef@) so that other data/entities can refer to it. -} +data Entity a = Entity { entityRef :: !(Ref a) + , entityData :: !a + } + +deriving instance (Eq a, Show a) => Eq (Entity a) +deriving instance (Eq a, Show a) => Show (Entity a) + +instance (FromField (Ref a), FromRow a) => FromRow (Entity a) where + fromRow = Entity -- Entity reference + <$> field + -- Delegetate to the actual entity to parse its data. + <*> fromRow + + +-------------------------------------------------------------------------------- +{-| Represents a view of a versioned MusicBrainz \'core\' entity at a specific +point in time (a specific 'Revision'). -} +data CoreEntity a = CoreEntity + { coreRef :: !(Ref a) + , coreRevision :: !(Ref (Revision a)) + , coreData :: !a + } + +deriving instance (Eq a, Show a) => Eq (CoreEntity a) +deriving instance (Eq a, Show a) => Show (CoreEntity a) + +instance (FromField (Ref a), FromRow a) => FromRow (CoreEntity a) where + fromRow = CoreEntity -- Core entity's MBID + <$> field + -- The revision reference + <*> field + -- Delegetate to the actual entity to parse its data. + <*> fromRow + + +-------------------------------------------------------------------------------- +{-| The 'Add' type class allows you to add new entities that are not +versioned. -} +class Add a where + {-| Add a new entity, with some starting data, producing a fresh 'Entity' + with a 'Ref'. -} + add :: (Functor m, MonadIO m) => a -> MusicBrainzT m (Entity a) + + +-------------------------------------------------------------------------------- +{-| A revision is a version of an entity at a specific point in time. The type +@a@ indicates what type of entity this is a revision of (e.g., @Revision Artist@ +means a specific revision of an 'Artist'). -} +data Revision a = Revision { revisionCreatedAt :: !UTCTime } + deriving (Eq, Show) + +instance Referenceable (Revision a) where + type RefSpec (Revision a) = Int + +instance FromField (Ref (Revision a)) where + fromField f v = view reference <$> fromField f v + +instance FromRow (Revision a) where + fromRow = Revision <$> field + +instance ToField (Ref (Revision a)) where + toField = toField . dereference + + +-------------------------------------------------------------------------------- +{-| Attempt to resolve a the revision which 2 revisions forked from. -} +mergeBase :: (Functor m, MonadIO m) => Ref (Revision a) -> Ref (Revision a) + -> MusicBrainzT m (Maybe (Ref (Revision a))) +mergeBase a b = listToMaybe . map fromOnly <$> query + [sql| WITH RECURSIVE revision_path (revision_id, parent_revision_id, distance) + AS ( + SELECT revision_id, parent_revision_id, 1 + FROM revision_parent + WHERE revision_id IN ? + + UNION + + SELECT + revision_path.revision_id, revision_parent.parent_revision_id, + distance + 1 + FROM revision_parent + JOIN revision_path + ON (revision_parent.revision_id = revision_path.parent_revision_id) + ) + SELECT parent_revision_id + FROM revision_path a + JOIN revision_path b USING (parent_revision_id) + ORDER BY a.distance, b.distance + LIMIT 1 |] (Only $ In [a, b]) + + + +-------------------------------------------------------------------------------- +{-| Find references to the parent revisions of a given revision. -} +revisionParents :: (Functor m, MonadIO m) + => Ref (Revision a) -> MusicBrainzT m (Set.Set (Ref (Revision a))) +revisionParents r = + Set.fromList . map fromOnly <$> query q (Only r) + where q = [sql| SELECT parent_revision_id FROM revision_parent + WHERE revision_id = ? |] + + +-------------------------------------------------------------------------------- +revisionChildren :: (Functor m, MonadIO m) + => Ref (Revision a) -> MusicBrainzT m (Set.Set (Ref (Revision a))) +revisionChildren r = + Set.fromList . map fromOnly <$> query q (Only r) + where q = [sql| SELECT revision_id FROM revision_parent + WHERE parent_revision_id = ? |] + + +-------------------------------------------------------------------------------- +instance GetEntity (Revision a) where + getEntity r = head <$> + query [sql| SELECT revision_id, created_at + FROM revision + WHERE revision_id = ? |] (Only r) + + +-------------------------------------------------------------------------------- +{-| View a specific revision, along with the basic 'treeData'. -} +class ViewRevision a where + viewRevision :: (Functor m, MonadIO m) + => Ref (Revision a) -> MusicBrainzT m (CoreEntity a) + + +-------------------------------------------------------------------------------- +class MasterRevision a where + setMasterRevision :: (Functor m, MonadIO m) + => Ref a -> Ref (Revision a) -> MusicBrainzT m () + + default setMasterRevision + :: (Functor m, MonadIO m, RootTable a, ToField (Ref a), ToField (Ref (Revision a))) + => Ref a -> Ref (Revision a) -> MusicBrainzT m () + setMasterRevision entityId revisionId = void $ + execute q (revisionId, entityId) + where + table = untag (rootTable :: Tagged a String) + q = fromString $ unlines + [ "UPDATE " ++ table ++ " SET master_revision_id = ? " + , "WHERE " ++ table ++ "_id = ?" + ] + + +-------------------------------------------------------------------------------- +class NewEntityRevision a where + newEntityRevision :: (Functor m, MonadIO m) + => Ref (Revision a) -> Ref a -> Ref (Tree a) -> MusicBrainzT m () + + default newEntityRevision + :: (Functor m, MonadIO m, RootTable a + , ToField (Ref (Tree a)), ToField (Ref (Revision a)), ToField (Ref a)) + => Ref (Revision a) -> Ref a -> Ref (Tree a) -> MusicBrainzT m () + newEntityRevision revisionId entityId entityTreeId = void $ + execute q (entityId, revisionId, entityTreeId) + where + entityName = untag (rootTable :: Tagged a String) + q = fromString $ unlines + [ "INSERT INTO " ++ entityName ++ "_revision (" ++ entityName ++ "_id, revision_id, " ++ entityName ++ "_tree_id) " + , "VALUES (?, ?, ?)" + ] + + +-------------------------------------------------------------------------------- +{-| The create type class allows you to create new entities. -} +class Create a where + {-| Create a new entity, with some starting data, producing a fresh MBID. -} + create :: Ref Editor -> Tree a -> EditT (Ref (Revision a)) + + default create + :: ( Editable a, FromField (Ref a), MasterRevision a, NewEntityRevision a + , RealiseTree a, RootTable a + ) + => Ref Editor -> Tree a -> EditT (Ref (Revision a)) + create editor entity = do + treeId <- realiseTree entity + entityId <- reserveEntityTable (untag (rootTable :: Tagged a String)) + revisionId <- newUnlinkedRevision editor + newEntityRevision revisionId entityId treeId + setMasterRevision entityId revisionId + includeRevision revisionId + return revisionId + + where + + reserveEntityTable table = selectValue $ query_ $ + fromString ("INSERT INTO " ++ table ++ " (master_revision_id) VALUES (-1) RETURNING " ++ table ++ "_id") + + +-------------------------------------------------------------------------------- +class GetEntity a where + getEntity :: (Functor m, MonadIO m) => Ref a -> MusicBrainzT m (Entity a) + +-------------------------------------------------------------------------------- +{-| Trees for entities are a somewhat internal concept of the way MusicBrainz +versioning works. A tree consists of all the data that is versioned for a +specific entity (of type @a@). -} +class HasTree a where + data Tree a :: * + + {-| A convenience accessor to the \'essential\' data inside a tree (the data + which contains the entities, and so on.) -} + treeData :: Tree a -> a + +instance Referenceable (Tree a) where + type RefSpec (Tree a) = Int + +instance FromField (Ref (Tree a)) where + fromField f v = view reference <$> fromField f v + +instance ToField (Ref (Tree a)) where + toField = toField . dereference + + +-------------------------------------------------------------------------------- +{-| View all data about a specific version of an entity. -} +class ViewTree a where + viewTree :: (Applicative m, MonadIO m) + => Ref (Revision a) -> MusicBrainzT m (Tree a) + + +-------------------------------------------------------------------------------- +{-| A MusicBrainz editor who makes changes to the database. -} +data Editor = Editor { editorName :: !Text + , editorPassword :: !Text + } + deriving (Eq, Show) + +instance Referenceable Editor where + type RefSpec Editor = Int + +instance FromField (Ref Editor) where + fromField f v = view reference <$> fromField f v + +instance FromRow Editor where + fromRow = Editor <$> field <*> field + +instance ToField (Ref Editor) where + toField = toField . dereference + +instance ToRow Editor where + toRow Editor{..} = [ toField editorName + , toField editorPassword + ] + +instance ResolveReference Editor where + resolveReference editorId = listToMaybe . map fromOnly <$> + query [sql| SELECT id FROM editor WHERE id = ? |] (Only editorId) + + +-------------------------------------------------------------------------------- +{-| Look up an editor by their name. -} +findEditorByName :: Text -> MusicBrainz (Maybe (Entity Editor)) +findEditorByName name = + listToMaybe <$> query [sql| SELECT id, name, password FROM editor WHERE name = ? |] + (Only name) + + +-------------------------------------------------------------------------------- +{-| Register a new MusicBrainz editor. -} +register :: Editor -> MusicBrainz (Entity Editor) +register editor = head <$> query + [sql| INSERT INTO editor (name, password) VALUES (?, ?) + RETURNING id, name, password |] editor + + +-------------------------------------------------------------------------------- +class ResolveReference a where + {-| Attempt to resolve a reference from its attributes. If the attributes + don't actually correspond to an entity in the database, then 'Nothing' is + returned. -} + resolveReference + :: (Functor m, MonadIO m) => RefSpec a -> MusicBrainzT m (Maybe (Ref a)) + + default resolveReference + :: (Functor m, MonadIO m, GenericResolver a (RefSpec a)) + => RefSpec a -> MusicBrainzT m (Maybe (Ref a)) + resolveReference = genericResolveReference + + +-------------------------------------------------------------------------------- +class RefSpec a ~ r => GenericResolver a r | r -> a where + genericResolveReference + :: (Functor m, MonadIO m) + => r -> MusicBrainzT m (Maybe (Ref a)) + +instance (RootTable a, FromField (Ref a), RefSpec a ~ MBID a) => GenericResolver a (MBID a) where + genericResolveReference entityMbid = + listToMaybe . map fromOnly <$> query q (Only entityMbid) + where + eName = untag (rootTable :: Tagged a String) + q = fromString $ unlines + [ "WITH RECURSIVE path (revision_id, " ++ eName ++ "_id, child_revision_id, created_at, is_master_revision_id) " + , "AS (" + , " SELECT " + , " " ++ eName ++ "_revision.revision_id, " + , " " ++ eName ++ "_revision." ++ eName ++ "_id, " + , " revision_parent.revision_id AS child_revision_id, " + , " created_at, " + , " TRUE as is_master_revision_id " + , " FROM " ++ eName ++ "_revision " + , " JOIN " ++ eName ++ " USING (" ++ eName ++ "_id) " + , " JOIN revision USING (revision_id) " + , " LEFT JOIN revision_parent ON (revision_parent.parent_revision_id = revision.revision_id) " + , " WHERE " ++ eName ++ "_id = ? AND master_revision_id = " ++ eName ++ "_revision.revision_id " + , " " + , " UNION " + , " " + , " SELECT " + , " " ++ eName ++ "_revision.revision_id, " + , " " ++ eName ++ "_revision." ++ eName ++ "_id, " + , " revision_parent.revision_id, " + , " revision.created_at, " + , " master_revision_id = " ++ eName ++ "_revision.revision_id AS is_master_revision_id " + , " FROM path " + , " JOIN " ++ eName ++ "_revision ON (path.child_revision_id = " ++ eName ++ "_revision.revision_id) " + , " JOIN revision ON (revision.revision_id = " ++ eName ++ "_revision.revision_id) " + , " JOIN " ++ eName ++ " ON (" ++ eName ++ "." ++ eName ++ "_id = " ++ eName ++ "_revision." ++ eName ++ "_id) " + , " LEFT JOIN revision_parent ON (revision_parent.parent_revision_id = " ++ eName ++ "_revision.revision_id) " + , ") " + , "SELECT " ++ eName ++ "_id " + , "FROM path " + , "WHERE is_master_revision_id " + , "ORDER BY created_at DESC, revision_id DESC " + , "LIMIT 1 " + ] + +instance RootTable a => GenericResolver (Revision a) Int where + genericResolveReference revisionId = + listToMaybe . map fromOnly <$> query q (Only revisionId) + where + eName = untag (rootTable :: Tagged a String) + q = fromString $ unlines + [ "SELECT revision_id " + , "FROM " ++ eName ++ "_revision " + , "WHERE revision_id = ?" + ] + + +-------------------------------------------------------------------------------- +{-| An edit bundles up multiple 'Revision's that have not yet been applied to +entities. Editors can then vote on these edits to decide if they should be +merge, which ModBot can then later merge (or reject) once a consensus +emerges. -} +data Edit = Edit + { editStatus :: EditStatus + } + deriving (Eq, Show) + +instance Referenceable Edit where + type RefSpec Edit = Int + +instance FromField (Ref Edit) where + fromField f v = view reference <$> fromField f v + +instance ToField EditStatus where + toField = toField . fromEnum + +instance ToField (Ref Edit) where + toField = toField . dereference + +instance ResolveReference Edit where + resolveReference editId = listToMaybe . map fromOnly <$> query q (Only editId) + where q = [sql| SELECT edit_id FROM edit WHERE edit_id = ? |] + + +-------------------------------------------------------------------------------- +{-| The possible states an edit can be in. -} +data EditStatus = Open | Closed + deriving (Eq, Show) + +instance Enum EditStatus where + fromEnum Open = 1 + fromEnum Closed = 2 + + toEnum 1 = Open + toEnum 2 = Closed + toEnum n = error $ show n ++ " cannot be converted to EditStatus" + + enumFrom = boundedEnumFrom + +instance Bounded EditStatus where + minBound = Open + maxBound = Closed + + +-------------------------------------------------------------------------------- +{-| An edit note is a comment that can be left by editors on edit notes, to +have a discussion about the changes being made, or to provide references for +other editors to verify changes against. -} +data EditNote = EditNote + { editNoteBody :: !Text + , editNoteAuthor :: !(Ref Editor) + } + deriving (Eq, Show) + +instance Referenceable EditNote where + type RefSpec EditNote = Int + +instance FromField (Ref EditNote) where + fromField f v = view reference <$> fromField f v + +instance FromRow EditNote where + fromRow = EditNote <$> field <*> field + +instance ToRow EditNote where + toRow EditNote{..} = [ toField editNoteAuthor + , toField editNoteBody + ] + + +-------------------------------------------------------------------------------- +{-| Given an edit that already exists, run 'EditM' actions against it, to +augment the edit with additional changes. -} +withEdit :: Ref Edit -> EditT a -> MusicBrainz a +withEdit editId action = fst <$> runEditT editId action + + +-------------------------------------------------------------------------------- +{-| Open a fresh edit, which can then have revisions added. -} +openEdit :: MusicBrainz (Ref Edit) +openEdit = selectValue $ query + [sql| INSERT INTO edit (status) VALUES (?) RETURNING edit_id |] + (Only Open) + + +-------------------------------------------------------------------------------- +mergeRevisionUpstream + :: (Applicative m, MonadIO m, FindLatest a, Mergeable (Tree a) + , NewEntityRevision a, RealiseTree a, MasterRevision a, ViewRevision a + , ViewTree a) + => Ref (Revision a) -> MusicBrainzT m () +mergeRevisionUpstream new = do + newVer <- viewRevision new + let artistId = coreRef newVer + + current <- viewOnce findLatest artistId + if coreRevision current == new + -- We aren't doing a merge at all, but we're simply 'creating' this + -- entity (by setting an upstream revision). + then setMasterRevision artistId new + + else do + ancestor' <- mergeBase new (coreRevision current) >>= traverse viewRevision + case ancestor' of + Nothing -> error "Unable to merge: no common ancestor" + Just ancestor -> do + newTree <- viewTree new + currentTree <- viewTree (coreRevision current) + ancestorTree <- viewTree (coreRevision ancestor) + + case runMerge newTree currentTree ancestorTree MusicBrainz.Merge.merge of + Nothing -> error "Unable to merge: conflict" + Just merged -> do + editorId <- selectValue $ query + [sql| SELECT editor_id FROM revision WHERE revision_id = ? |] + (Only $ coreRevision current) + + treeId <- realiseTree merged + revisionId <- newChildRevision editorId (coreRevision current) treeId + addChild revisionId new + + setMasterRevision artistId revisionId + +-------------------------------------------------------------------------------- +data Change = forall entity. + Editable entity => Change (Ref (Revision entity)) + + +-------------------------------------------------------------------------------- +{-| Accumulate many changes inside a single Edit. -} +type EditT = MusicBrainzT (WriterT [Change] IO) + + +-------------------------------------------------------------------------------- +{-| Include a specific 'Revision' as part of an edit. + +This is a fairly low-level operation, and you should be careful that you only +include revisions that haven't already been merged! -} +includeRevision :: Editable a => Ref (Revision a) -> EditT () +includeRevision = lift . tell . return . Change + + +-------------------------------------------------------------------------------- +{-| The 'Editable' class has instances which have versioning and thus can be +included in edits. -} +--class (FindLatest a, MasterRevision a, Mergeable (Tree a), +class (FindLatest a, Mergeable (Tree a), MasterRevision a, NewEntityRevision a, RealiseTree a, ViewTree a, ViewRevision a) => Editable a where + {-| Add a revision into an edit. -} + linkRevisionToEdit :: Ref Edit -> Ref (Revision a) -> MusicBrainz () + + default linkRevisionToEdit + :: (RootTable a, ToField (Ref Edit), ToField (Ref (Revision a))) + => Ref Edit -> Ref (Revision a) -> MusicBrainz () + linkRevisionToEdit editId revisionId = void $ execute q (editId, revisionId) + where + table = "edit_" ++ untag (rootTable :: Tagged a String) + q = fromString $ unlines + [ "INSERT INTO " ++ table ++ " (edit_id, revision_id)" + , " VALUES (?, ?)" + ] + + +-------------------------------------------------------------------------------- +runEditT :: Ref Edit -> EditT a -> MusicBrainz (a, [Change]) +runEditT editId action = do + (a, changes) <- fmap runWriterT (nestMb action) >>= liftIO + mapM_ linkChange changes + return (a, changes) + + where + + linkChange :: Change -> MusicBrainz () + linkChange (Change r) = linkRevisionToEdit editId r + + +-------------------------------------------------------------------------------- +runUpdate + :: (Editable a, NewEntityRevision a, RealiseTree a, ViewRevision a) + => Ref Editor -> Ref (Revision a) -> Tree a -> EditT (Ref (Revision a)) +runUpdate editor base tree = do + treeId <- realiseTree tree + revisionId <- newChildRevision editor base treeId + includeRevision revisionId + return revisionId + + +-------------------------------------------------------------------------------- +{-| Merge one entity into another. -} +merge :: (FindLatest a, Editable a, CloneRevision a) + => Ref Editor -> Ref (Revision a) -> Ref a -> EditT (Ref (Revision a)) +merge editor baseRev targetId = do + -- Find the latest revision to merge into + latestTarget <- viewOnce findLatest targetId + mergeInto <- cloneRevision latestTarget editor + + -- Link this revision to both the old tree and the latest version, + -- and include it in the edit. + includeRevision mergeInto + addChild mergeInto baseRev + addChild mergeInto (coreRevision latestTarget) + + return mergeInto + + +-------------------------------------------------------------------------------- +{-| Create an edit, and run an 'EditT' action to create the various components +of the edit (that is, link revisions to the edit). -} +createEdit :: EditT a -> MusicBrainz (Ref Edit) +createEdit actions = do + editId <- openEdit + runEditT editId actions + return editId + +-------------------------------------------------------------------------------- +{-| Allow an editor to cast a 'Vote' on an edit. -} +voteOnEdit :: Ref Editor -> Ref Edit -> VoteScore -> MusicBrainz () +voteOnEdit editorId editId vote = void $ execute + [sql| INSERT INTO vote (edit_id, editor_id, vote) VALUES (?, ?, ?) |] + (editId, editorId, vote) + + +-------------------------------------------------------------------------------- +{-| Append an edit note to the list of edit notes for an edit. -} +addEditNote :: Ref Edit -> EditNote -> MusicBrainz () +addEditNote editId note = void $ execute + [sql| INSERT INTO edit_note (edit_id, editor_id, text) VALUES (?, ?, ?) |] + (Only editId :. note) + + +-------------------------------------------------------------------------------- +{-| Find all edit notes for an edit. -} +findEditNotes :: Ref Edit -> MusicBrainz [Entity EditNote] +findEditNotes editId = query + [sql| SELECT edit_note_id, text, editor_id FROM edit_note WHERE edit_id = ? |] + (Only editId) + + +-------------------------------------------------------------------------------- +{-| A vote on an edit. -} +data Vote = Vote { voteVote :: !VoteScore + , voteEditor :: !(Ref Editor) + , voteSuperceded :: !Bool + } + deriving (Eq, Show) + +instance FromRow Vote where + fromRow = Vote <$> field <*> field <*> field + + +-------------------------------------------------------------------------------- +{-| The possible types of votes that editors can cast on an edit. -} +data VoteScore = Accept | Reject | Abstain + deriving (Eq, Show) + +-- A custom instance here allows us to use -1 for reject. +instance Enum VoteScore where + fromEnum Accept = 1 + fromEnum Reject = -1 + fromEnum Abstain = 0 + + toEnum 1 = Accept + toEnum (-1) = Reject + toEnum 0 = Abstain + toEnum n = error $ show n ++ " cannot be converted to Vote" + + enumFrom = boundedEnumFrom + +instance Bounded VoteScore where + minBound = Reject + maxBound = Accept + +instance FromField VoteScore where + fromField f v = toEnum <$> fromField f v + +instance ToField VoteScore where + toField = toField . fromEnum + + +-------------------------------------------------------------------------------- +listVotes :: (Functor m, Monad m, MonadIO m) => Ref Edit -> MusicBrainzT m [Vote] +listVotes editId = + query [sql| + SELECT vote, editor_id, + row_number() OVER (PARTITION BY editor_id ORDER BY vote_time DESC) > 1 AS superceded + FROM vote + WHERE edit_id = ? + ORDER BY vote_time ASC + |] (Only editId) + + +-------------------------------------------------------------------------------- +{-| Create a new \'system\' revision, that is not yet bound to any entity. -} +newUnlinkedRevision :: (Functor m, MonadIO m) + => Ref Editor -> MusicBrainzT m (Ref (Revision a)) +newUnlinkedRevision editor = selectValue $ + query [sql| INSERT INTO revision (editor_id) VALUES (?) RETURNING revision_id |] + (Only editor) + + +-------------------------------------------------------------------------------- +{-| Add one 'Revision' as a child of another (parent) 'Revision'. -} +addChild :: (Functor m, MonadIO m) => Ref (Revision a) -> Ref (Revision a) -> MusicBrainzT m () +addChild childRevision parentRevision = + void $ execute + [sql| INSERT INTO revision_parent (revision_id, parent_revision_id) + VALUES (?, ?) |] (childRevision, parentRevision) + + +-------------------------------------------------------------------------------- +class CloneRevision a where + cloneRevision :: (Functor m, MonadIO m) + => CoreEntity a -> Ref Editor -> MusicBrainzT m (Ref (Revision a)) + + default cloneRevision + :: (Functor m, MonadIO m, ToField (Ref a), RootTable a) + => CoreEntity a -> Ref Editor -> MusicBrainzT m (Ref (Revision a)) + cloneRevision a editor = do + revId <- newUnlinkedRevision editor + selectValue $ query q (coreRef a, revId, coreRevision a) + + where + + entityName = untag (rootTable :: Tagged a String) + q = fromString $ unlines + [ "INSERT INTO " ++ entityName ++ "_revision (" ++ entityName ++ "_id, revision_id, " ++ entityName ++ "_tree_id) " + , "VALUES (?, ?, (SELECT " ++ entityName ++ "_tree_id FROM " ++ entityName ++ "_revision WHERE revision_id = ?)) " + , "RETURNING revision_id" + ] + + + +-------------------------------------------------------------------------------- +newChildRevision :: (Functor m, MonadIO m, ViewRevision a, NewEntityRevision a) + => Ref Editor -> Ref (Revision a) -> Ref (Tree a) + -> MusicBrainzT m (Ref (Revision a)) +newChildRevision editorId baseRevisionId treeId = do + entity <- viewRevision baseRevisionId + revisionId <- newUnlinkedRevision editorId + newEntityRevision revisionId (coreRef entity) treeId + addChild revisionId baseRevisionId + return revisionId + + +-------------------------------------------------------------------------------- +class RealiseTree a where + realiseTree :: (Functor m, MonadIO m) + => Tree a -> MusicBrainzT m (Ref (Tree a)) + +-------------------------------------------------------------------------------- +{-| Attempt to find the latest revision of an entity (type @a@), by a given +'Ref'. To obtain the reference, you can use +'MusicBrainz.Merge.resolveMbid'. -} +class FindLatest a where + findLatest :: (Applicative m, Functor m, MonadIO m) => + Set.Set (Ref a) -> MusicBrainzT m (Map.Map (Ref a) (CoreEntity a)) diff --git a/src/MusicBrainz/Work.hs b/src/MusicBrainz/Work.hs index d93c6bc..a7d30f7 100644 --- a/src/MusicBrainz/Work.hs +++ b/src/MusicBrainz/Work.hs @@ -30,26 +30,14 @@ import MusicBrainz.Monad import MusicBrainz.Alias import MusicBrainz.Annotation import MusicBrainz.Artist -import MusicBrainz.Class.Create -import MusicBrainz.Class.FindLatest -import MusicBrainz.Class.MasterRevision -import MusicBrainz.Class.NewEntityRevision -import MusicBrainz.Class.RealiseTree -import MusicBrainz.Class.ResolveReference import MusicBrainz.Class.RootTable import MusicBrainz.Class.Update -import MusicBrainz.Class.ViewRevision -import MusicBrainz.Edit (Editable(..)) -import MusicBrainz.Entity import MusicBrainz.ISWC hiding (iswc) import MusicBrainz.Language (Language) import MusicBrainz.MBID (MBID) -import MusicBrainz.Ref (Ref, Referenceable(..), reference, dereference) import MusicBrainz.Relationship -import MusicBrainz.Relationship.Internal (HoldsRelationships(..), viewRelationships) -import MusicBrainz.Revision (Revision) -import MusicBrainz.Revision.Internal (CloneRevision(..)) -import MusicBrainz.Tree +import MusicBrainz.Relationship.Internal +import MusicBrainz.Versioning hiding (merge) import {-# SOURCE #-} qualified MusicBrainz.Generic as Generic diff --git a/src/MusicBrainz/Work.hs-boot b/src/MusicBrainz/Work.hs-boot index 0625d33..0127965 100644 --- a/src/MusicBrainz/Work.hs-boot +++ b/src/MusicBrainz/Work.hs-boot @@ -2,7 +2,7 @@ module MusicBrainz.Work where import Database.PostgreSQL.Simple.FromField (FromField) -import MusicBrainz.Ref (Ref) +import MusicBrainz.Versioning data Work diff --git a/test/framework/Test/MusicBrainz.hs b/test/framework/Test/MusicBrainz.hs index cabd268..5755cfd 100644 --- a/test/framework/Test/MusicBrainz.hs +++ b/test/framework/Test/MusicBrainz.hs @@ -45,8 +45,8 @@ import qualified Test.Framework.Providers.QuickCheck2 import qualified Test.QuickCheck import MusicBrainz.Monad -import MusicBrainz.Edit import MusicBrainz.EditApplication +import MusicBrainz.Versioning data TestEnvironment = TestEnvironment { testContexts :: Chan Context } diff --git a/test/suite/MusicBrainz/AliasType/Tests.hs b/test/suite/MusicBrainz/AliasType/Tests.hs index 91dd84b..852f2d5 100644 --- a/test/suite/MusicBrainz/AliasType/Tests.hs +++ b/test/suite/MusicBrainz/AliasType/Tests.hs @@ -7,8 +7,8 @@ import qualified Test.MusicBrainz.CommonTests as CommonTests import MusicBrainz.Alias import MusicBrainz.Artist -import MusicBrainz.Entity import MusicBrainz.Label +import MusicBrainz.Versioning import MusicBrainz.Work -------------------------------------------------------------------------------- diff --git a/test/suite/MusicBrainz/Artist/Tests.hs b/test/suite/MusicBrainz/Artist/Tests.hs index 7a7d4ae..44d1e89 100644 --- a/test/suite/MusicBrainz/Artist/Tests.hs +++ b/test/suite/MusicBrainz/Artist/Tests.hs @@ -13,8 +13,8 @@ import qualified Test.MusicBrainz.CommonTests as CommonTests import MusicBrainz.Alias import MusicBrainz.Artist -import MusicBrainz.Entity import MusicBrainz.PartialDate +import MusicBrainz.Versioning {- import qualified Data.Set as Set diff --git a/test/suite/MusicBrainz/ArtistCredit/Tests.hs b/test/suite/MusicBrainz/ArtistCredit/Tests.hs index 75a4d3e..970581b 100644 --- a/test/suite/MusicBrainz/ArtistCredit/Tests.hs +++ b/test/suite/MusicBrainz/ArtistCredit/Tests.hs @@ -12,10 +12,7 @@ import Test.MusicBrainz.Repository import MusicBrainz.Artist import MusicBrainz.ArtistCredit -import MusicBrainz.Class.Create -import MusicBrainz.Class.ViewRevision -import MusicBrainz.Editor -import MusicBrainz.Entity +import MusicBrainz.Versioning -------------------------------------------------------------------------------- tests :: [Test] diff --git a/test/suite/MusicBrainz/ArtistType/Tests.hs b/test/suite/MusicBrainz/ArtistType/Tests.hs index aba28fa..a0a41bd 100644 --- a/test/suite/MusicBrainz/ArtistType/Tests.hs +++ b/test/suite/MusicBrainz/ArtistType/Tests.hs @@ -6,7 +6,7 @@ import Test.MusicBrainz.Repository (person) import qualified Test.MusicBrainz.CommonTests as CommonTests -import MusicBrainz.Entity +import MusicBrainz.Versioning -------------------------------------------------------------------------------- tests :: [Test] diff --git a/test/suite/MusicBrainz/Country/Tests.hs b/test/suite/MusicBrainz/Country/Tests.hs index 3bf4b26..7f0248c 100644 --- a/test/suite/MusicBrainz/Country/Tests.hs +++ b/test/suite/MusicBrainz/Country/Tests.hs @@ -6,7 +6,7 @@ import Test.MusicBrainz.Repository (uk) import qualified Test.MusicBrainz.CommonTests as CommonTests -import MusicBrainz.Entity +import MusicBrainz.Versioning -------------------------------------------------------------------------------- tests :: [Test] diff --git a/test/suite/MusicBrainz/Edit/Tests.hs b/test/suite/MusicBrainz/Edit/Tests.hs index 22cba74..f5f0c5c 100644 --- a/test/suite/MusicBrainz/Edit/Tests.hs +++ b/test/suite/MusicBrainz/Edit/Tests.hs @@ -9,9 +9,7 @@ import Test.MusicBrainz.Repository import qualified Test.MusicBrainz.CommonTests as CommonTests -import MusicBrainz.Edit -import MusicBrainz.Editor -import MusicBrainz.Entity +import MusicBrainz.Versioning -------------------------------------------------------------------------------- tests :: [Test] diff --git a/test/suite/MusicBrainz/Editor/Tests.hs b/test/suite/MusicBrainz/Editor/Tests.hs index 2e344db..9293a82 100644 --- a/test/suite/MusicBrainz/Editor/Tests.hs +++ b/test/suite/MusicBrainz/Editor/Tests.hs @@ -3,10 +3,7 @@ module MusicBrainz.Editor.Tests where import Test.MusicBrainz -import MusicBrainz.Class.ResolveReference -import MusicBrainz.Entity -import MusicBrainz.Editor -import MusicBrainz.Ref +import MusicBrainz.Versioning tests :: [Test] tests = [ testRegister diff --git a/test/suite/MusicBrainz/Gender/Tests.hs b/test/suite/MusicBrainz/Gender/Tests.hs index a6c91e4..976b662 100644 --- a/test/suite/MusicBrainz/Gender/Tests.hs +++ b/test/suite/MusicBrainz/Gender/Tests.hs @@ -6,7 +6,7 @@ import Test.MusicBrainz.Repository (male) import qualified Test.MusicBrainz.CommonTests as CommonTests -import MusicBrainz.Entity +import MusicBrainz.Versioning -------------------------------------------------------------------------------- tests :: [Test] diff --git a/test/suite/MusicBrainz/LabelType/Tests.hs b/test/suite/MusicBrainz/LabelType/Tests.hs index ba34e1a..42d5217 100644 --- a/test/suite/MusicBrainz/LabelType/Tests.hs +++ b/test/suite/MusicBrainz/LabelType/Tests.hs @@ -5,8 +5,8 @@ import Test.MusicBrainz import qualified Test.MusicBrainz.CommonTests as CommonTests -import MusicBrainz.Entity import MusicBrainz.Label +import MusicBrainz.Versioning -------------------------------------------------------------------------------- tests :: [Test] diff --git a/test/suite/MusicBrainz/Language/Tests.hs b/test/suite/MusicBrainz/Language/Tests.hs index 2166834..07963c2 100644 --- a/test/suite/MusicBrainz/Language/Tests.hs +++ b/test/suite/MusicBrainz/Language/Tests.hs @@ -6,7 +6,7 @@ import Test.MusicBrainz.Repository (english) import qualified Test.MusicBrainz.CommonTests as CommonTests -import MusicBrainz.Entity +import MusicBrainz.Versioning -------------------------------------------------------------------------------- tests :: [Test] diff --git a/test/suite/MusicBrainz/MediumFormat/Tests.hs b/test/suite/MusicBrainz/MediumFormat/Tests.hs index da8dc65..770c939 100644 --- a/test/suite/MusicBrainz/MediumFormat/Tests.hs +++ b/test/suite/MusicBrainz/MediumFormat/Tests.hs @@ -5,8 +5,8 @@ import Test.MusicBrainz import qualified Test.MusicBrainz.CommonTests as CommonTests -import MusicBrainz.Entity import MusicBrainz.Release +import MusicBrainz.Versioning -------------------------------------------------------------------------------- tests :: [Test] diff --git a/test/suite/MusicBrainz/Recording/Tests.hs b/test/suite/MusicBrainz/Recording/Tests.hs index 3d08036..e17f330 100644 --- a/test/suite/MusicBrainz/Recording/Tests.hs +++ b/test/suite/MusicBrainz/Recording/Tests.hs @@ -13,18 +13,13 @@ import Test.MusicBrainz.Repository import qualified Test.MusicBrainz.CommonTests as CommonTests -import MusicBrainz.Monad -import MusicBrainz.Util (viewOnce) import MusicBrainz.ArtistCredit -import MusicBrainz.Class.Create -import MusicBrainz.Class.ViewRevision -import MusicBrainz.Editor -import MusicBrainz.Entity -import MusicBrainz.Ref +import MusicBrainz.ISRC +import MusicBrainz.Monad import MusicBrainz.Recording import MusicBrainz.Release hiding (findByArtist) -import MusicBrainz.ISRC -import MusicBrainz.Tree +import MusicBrainz.Util (viewOnce) +import MusicBrainz.Versioning -------------------------------------------------------------------------------- tests :: [Test] diff --git a/test/suite/MusicBrainz/Relationship/Tests.hs b/test/suite/MusicBrainz/Relationship/Tests.hs index 5f4543d..459d661 100644 --- a/test/suite/MusicBrainz/Relationship/Tests.hs +++ b/test/suite/MusicBrainz/Relationship/Tests.hs @@ -12,27 +12,21 @@ import Test.MusicBrainz.Repository import qualified Test.MusicBrainz.CommonTests as CommonTests -import MusicBrainz.Util (viewOnce) -import MusicBrainz.Monad -import MusicBrainz.Class.Create -import MusicBrainz.Class.FindLatest +import MusicBrainz.Artist hiding (ArtistTree) import MusicBrainz.Class.Update -import MusicBrainz.Class.ViewRevision -import MusicBrainz.Edit import MusicBrainz.EditApplication -import MusicBrainz.Editor -import MusicBrainz.Entity +import MusicBrainz.Label hiding (LabelTree) +import MusicBrainz.Monad import MusicBrainz.PartialDate -import MusicBrainz.Relationship -import MusicBrainz.Tree import MusicBrainz.Recording hiding (RecordingTree) +import MusicBrainz.Relationship +import MusicBrainz.Relationship.Internal (relationships) import MusicBrainz.Release hiding (ReleaseTree) import MusicBrainz.ReleaseGroup hiding (ReleaseGroupTree) -import MusicBrainz.Artist hiding (ArtistTree) import MusicBrainz.URL hiding (URLTree) +import MusicBrainz.Util (viewOnce) +import MusicBrainz.Versioning import MusicBrainz.Work hiding (WorkTree) -import MusicBrainz.Label hiding (LabelTree) -import MusicBrainz.Ref import qualified MusicBrainz.Relationship.Internal as Relationship diff --git a/test/suite/MusicBrainz/Release/Tests.hs b/test/suite/MusicBrainz/Release/Tests.hs index e89c7e0..0399403 100644 --- a/test/suite/MusicBrainz/Release/Tests.hs +++ b/test/suite/MusicBrainz/Release/Tests.hs @@ -15,16 +15,12 @@ import Test.MusicBrainz.Repository (dummyReleaseTree, acid2, revolutionRecords, import qualified Test.MusicBrainz.CommonTests as CommonTests -import MusicBrainz.Monad -import MusicBrainz.Util (viewOnce) import MusicBrainz.ArtistCredit -import MusicBrainz.Class.Create -import MusicBrainz.Class.ViewRevision -import MusicBrainz.Editor -import MusicBrainz.Entity -import MusicBrainz.Ref +import MusicBrainz.Monad import MusicBrainz.Recording (recordingArtistCredit) import MusicBrainz.Release +import MusicBrainz.Util (viewOnce) +import MusicBrainz.Versioning -------------------------------------------------------------------------------- tests :: [Test] diff --git a/test/suite/MusicBrainz/ReleaseGroup/Tests.hs b/test/suite/MusicBrainz/ReleaseGroup/Tests.hs index 764e57a..5112bf0 100644 --- a/test/suite/MusicBrainz/ReleaseGroup/Tests.hs +++ b/test/suite/MusicBrainz/ReleaseGroup/Tests.hs @@ -12,16 +12,11 @@ import Test.MusicBrainz.Repository import qualified Test.MusicBrainz.CommonTests as CommonTests -import MusicBrainz.Util (viewOnce) import MusicBrainz.ArtistCredit -import MusicBrainz.Class.Create -import MusicBrainz.Class.ViewRevision -import MusicBrainz.Edit import MusicBrainz.EditApplication -import MusicBrainz.Editor -import MusicBrainz.Entity import MusicBrainz.ReleaseGroup -import MusicBrainz.Tree +import MusicBrainz.Util (viewOnce) +import MusicBrainz.Versioning -------------------------------------------------------------------------------- tests :: [Test] diff --git a/test/suite/MusicBrainz/ReleaseGroupType/Tests.hs b/test/suite/MusicBrainz/ReleaseGroupType/Tests.hs index 0c9a9b3..73c2258 100644 --- a/test/suite/MusicBrainz/ReleaseGroupType/Tests.hs +++ b/test/suite/MusicBrainz/ReleaseGroupType/Tests.hs @@ -6,8 +6,8 @@ import Test.MusicBrainz.Repository (compilation) import qualified Test.MusicBrainz.CommonTests as CommonTests -import MusicBrainz.Entity import MusicBrainz.ReleaseGroup +import MusicBrainz.Versioning -------------------------------------------------------------------------------- tests :: [Test] diff --git a/test/suite/MusicBrainz/ReleasePackaging/Tests.hs b/test/suite/MusicBrainz/ReleasePackaging/Tests.hs index 6ca1c28..bcaf5d0 100644 --- a/test/suite/MusicBrainz/ReleasePackaging/Tests.hs +++ b/test/suite/MusicBrainz/ReleasePackaging/Tests.hs @@ -5,8 +5,8 @@ import Test.MusicBrainz import qualified Test.MusicBrainz.CommonTests as CommonTests -import MusicBrainz.Entity import MusicBrainz.Release +import MusicBrainz.Versioning -------------------------------------------------------------------------------- tests :: [Test] diff --git a/test/suite/MusicBrainz/ReleaseStatus/Tests.hs b/test/suite/MusicBrainz/ReleaseStatus/Tests.hs index d226afa..3aa2c4a 100644 --- a/test/suite/MusicBrainz/ReleaseStatus/Tests.hs +++ b/test/suite/MusicBrainz/ReleaseStatus/Tests.hs @@ -5,8 +5,8 @@ import Test.MusicBrainz import qualified Test.MusicBrainz.CommonTests as CommonTests -import MusicBrainz.Entity import MusicBrainz.Release +import MusicBrainz.Versioning -------------------------------------------------------------------------------- tests :: [Test] diff --git a/test/suite/MusicBrainz/Script/Tests.hs b/test/suite/MusicBrainz/Script/Tests.hs index fc0c915..d691a96 100644 --- a/test/suite/MusicBrainz/Script/Tests.hs +++ b/test/suite/MusicBrainz/Script/Tests.hs @@ -6,8 +6,8 @@ import Test.MusicBrainz.Repository (latin) import qualified Test.MusicBrainz.CommonTests as CommonTests -import MusicBrainz.Entity import MusicBrainz.Script () +import MusicBrainz.Versioning -------------------------------------------------------------------------------- tests :: [Test] diff --git a/test/suite/MusicBrainz/Url/Tests.hs b/test/suite/MusicBrainz/Url/Tests.hs index 7131c15..a028e6d 100644 --- a/test/suite/MusicBrainz/Url/Tests.hs +++ b/test/suite/MusicBrainz/Url/Tests.hs @@ -8,14 +8,8 @@ import Test.MusicBrainz.Repository import qualified Test.MusicBrainz.CommonTests as CommonTests -import MusicBrainz.Class.Create -import MusicBrainz.Class.ViewRevision -import MusicBrainz.Edit import MusicBrainz.EditApplication -import MusicBrainz.Editor -import MusicBrainz.Entity -import MusicBrainz.Ref -import MusicBrainz.Class.ResolveReference +import MusicBrainz.Versioning -------------------------------------------------------------------------------- tests :: [Test] diff --git a/test/suite/MusicBrainz/Work/Tests.hs b/test/suite/MusicBrainz/Work/Tests.hs index ff85618..45a060b 100644 --- a/test/suite/MusicBrainz/Work/Tests.hs +++ b/test/suite/MusicBrainz/Work/Tests.hs @@ -14,23 +14,16 @@ import Test.MusicBrainz.Repository import qualified Test.MusicBrainz.CommonTests as CommonTests -import MusicBrainz.Util (viewOnce) import MusicBrainz.Alias import MusicBrainz.ArtistCredit -import MusicBrainz.Class.Create -import MusicBrainz.Class.ViewRevision -import MusicBrainz.ISWC -import MusicBrainz.Edit import MusicBrainz.EditApplication -import MusicBrainz.Editor -import MusicBrainz.Entity +import MusicBrainz.ISWC import MusicBrainz.PartialDate +import MusicBrainz.Recording (recordingArtistCredit) import MusicBrainz.Relationship -import MusicBrainz.Ref +import MusicBrainz.Util (viewOnce) import MusicBrainz.Work -import MusicBrainz.Class.ResolveReference -import MusicBrainz.Tree -import MusicBrainz.Recording (recordingArtistCredit) +import MusicBrainz.Versioning -------------------------------------------------------------------------------- tests :: [Test] diff --git a/test/suite/MusicBrainz/WorkType/Tests.hs b/test/suite/MusicBrainz/WorkType/Tests.hs index c819622..3d8dfe9 100644 --- a/test/suite/MusicBrainz/WorkType/Tests.hs +++ b/test/suite/MusicBrainz/WorkType/Tests.hs @@ -5,7 +5,7 @@ import Test.MusicBrainz import qualified Test.MusicBrainz.CommonTests as CommonTests -import MusicBrainz.Entity +import MusicBrainz.Versioning import MusicBrainz.Work -------------------------------------------------------------------------------- diff --git a/test/suite/Test/MusicBrainz/CommonTests.hs b/test/suite/Test/MusicBrainz/CommonTests.hs index f793dc2..fbe1c0b 100644 --- a/test/suite/Test/MusicBrainz/CommonTests.hs +++ b/test/suite/Test/MusicBrainz/CommonTests.hs @@ -32,24 +32,13 @@ import MusicBrainz.Monad import MusicBrainz.Alias import MusicBrainz.Annotation import MusicBrainz.Class.Cleanup -import MusicBrainz.Class.Create -import MusicBrainz.Class.FindLatest -import MusicBrainz.Class.GetEntity -import MusicBrainz.Class.ResolveReference import MusicBrainz.Class.Update -import MusicBrainz.Class.ViewRevision -import MusicBrainz.Edit import MusicBrainz.EditApplication -import MusicBrainz.Editor -import MusicBrainz.Entity import MusicBrainz.IPI import MusicBrainz.ISNI import MusicBrainz.MBID -import MusicBrainz.Ref import MusicBrainz.Relationship.Internal -import MusicBrainz.Revision -import MusicBrainz.Revision.Internal -import MusicBrainz.Tree +import MusicBrainz.Versioning -------------------------------------------------------------------------------- createAndUpdateSubtree :: diff --git a/test/suite/Test/MusicBrainz/Data.hs b/test/suite/Test/MusicBrainz/Data.hs index 4d81584..acd71b3 100644 --- a/test/suite/Test/MusicBrainz/Data.hs +++ b/test/suite/Test/MusicBrainz/Data.hs @@ -6,13 +6,8 @@ import Data.Monoid (mempty) import MusicBrainz.Monad import MusicBrainz.Artist import MusicBrainz.ArtistCredit (ArtistCredit, ArtistCreditName(..), getRef) -import MusicBrainz.Class.Create (create) -import MusicBrainz.Class.ViewRevision (viewRevision) -import MusicBrainz.Editor (Editor) -import MusicBrainz.Edit import MusicBrainz.EditApplication -import MusicBrainz.Entity (coreRef, coreData) -import MusicBrainz.Ref (Ref) +import MusicBrainz.Versioning -------------------------------------------------------------------------------- singleArtistAc :: Ref Editor -> Artist -> MusicBrainz (Ref ArtistCredit) diff --git a/test/suite/Test/MusicBrainz/Repository.hs b/test/suite/Test/MusicBrainz/Repository.hs index 9107165..551d0b2 100644 --- a/test/suite/Test/MusicBrainz/Repository.hs +++ b/test/suite/Test/MusicBrainz/Repository.hs @@ -9,22 +9,18 @@ import Network.URI (parseURI) import MusicBrainz.Monad import MusicBrainz.Artist import MusicBrainz.ArtistCredit -import MusicBrainz.Class.Create -import MusicBrainz.Class.ViewRevision import MusicBrainz.Country -import MusicBrainz.Editor -import MusicBrainz.Entity import MusicBrainz.Gender import MusicBrainz.Label import MusicBrainz.Language import MusicBrainz.PartialDate import MusicBrainz.Recording -import MusicBrainz.Ref import MusicBrainz.Relationship import MusicBrainz.Release import MusicBrainz.ReleaseGroup import MusicBrainz.Script import MusicBrainz.URL +import MusicBrainz.Versioning import MusicBrainz.Work import Test.MusicBrainz