[Ngrams] reordering of type fields

src/Gargantext/Core/Types/Ngrams.hs

@@ -13,7 +13,7 @@ import qualified Data.HashMap.Strict.InsOrd             as InsOrdHashMap
 import Data.Foldable (foldMap)
 import qualified Data.List as List
 import Data.Map.Strict.Patch (PatchMap)
-import Data.Patch.Class (Composable, ConflictResolution, ConflictResolutionReplace, Group, Patched, Replace, Transformable(..))
+import Data.Patch.Class (Action(..), Applicable(..), Composable, ConflictResolution, ConflictResolutionReplace, Group, MaybePatch(Mod), Patched, PairPatch(..), Replace, Transformable(..))
 import Data.Proxy (Proxy(..))
 import Data.Semigroup (Semigroup)
 import Data.Map.Strict (Map)
@@ -37,17 +37,13 @@ import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
 newtype MSet a = MSet (Map a ())
   deriving (Eq, Ord, Show, Generic, Arbitrary, Semigroup, Monoid)
-
 instance ToJSON a => ToJSON (MSet a) where
   toJSON     (MSet m) = toJSON     (Map.keys m)
   toEncoding (MSet m) = toEncoding (Map.keys m)
-
 instance Foldable MSet where
   foldMap f (MSet m) = Map.foldMapWithKey (\k _ -> f k) m
-
 instance (Ord a, FromJSON a) => FromJSON (MSet a) where
   parseJSON = fmap mSetFromList . parseJSON
-
 instance (ToJSONKey a, ToSchema a) => ToSchema (MSet a) where
   -- TODO
   declareNamedSchema _ = wellNamedSchema "" (Proxy :: Proxy TODO)
@@ -70,19 +66,14 @@ mSetToList (MSet a) = Map.keys a
 
 newtype NgramsTerm = NgramsTerm { unNgramsTerm :: Text }
   deriving (Ord, Eq, Show, Generic, ToJSONKey, ToJSON, FromJSON, Semigroup, Arbitrary, Serialise, ToSchema, Hashable, NFData)
-
 instance IsHashable NgramsTerm where
   hash (NgramsTerm t) = hash t
-
 instance Monoid NgramsTerm where
   mempty = NgramsTerm ""
-
 instance FromJSONKey NgramsTerm where
   fromJSONKey = FromJSONKeyTextParser $ \t -> pure $ NgramsTerm $ strip t
-
 instance IsString NgramsTerm where
   fromString s = NgramsTerm $ pack s
-
 instance FromField NgramsTerm
   where
     fromField field mb = do
@@ -103,6 +94,10 @@ data NgramsRepoElement = NgramsRepoElement
   , _nre_children    :: !(MSet NgramsTerm)
   }
   deriving (Ord, Eq, Show, Generic)
+instance ToSchema NgramsRepoElement where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_nre_")
+instance Serialise (MSet NgramsTerm)
+instance Serialise NgramsRepoElement
 
 deriveJSON (unPrefix "_nre_") ''NgramsRepoElement
 -- TODO
@@ -111,12 +106,10 @@ deriveJSON (unPrefix "_nre_") ''NgramsRepoElement
 
 makeLenses ''NgramsRepoElement
 
-instance ToSchema NgramsRepoElement where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_nre_")
-
-instance Serialise (MSet NgramsTerm)
-instance Serialise NgramsRepoElement
+type NgramsTableMap = Map NgramsTerm NgramsRepoElement
 
+type AddRem = Replace (Maybe ())
+instance Serialise AddRem
 
 
 newtype PatchMSet a = PatchMSet (PatchMap a AddRem)
@@ -133,10 +126,6 @@ instance (Serialise a, Ord a) => Serialise (PatchMap a AddRem)
 instance (Serialise a, Ord a) => Serialise (PatchMSet a)
 
 
-type AddRem = Replace (Maybe ())
-instance Serialise AddRem
-
-
 data NgramsPatch
    = NgramsPatch { _patch_children :: !(PatchMSet NgramsTerm)
                  , _patch_list     :: !(Replace ListType)   -- TODO Map UserId ListType
@@ -145,7 +134,6 @@ data NgramsPatch
                    , _patch_new :: !(Maybe NgramsRepoElement)
                    }
       deriving (Eq, Show, Generic)
-
 instance Semigroup NgramsPatch where
   p <> q = _NgramsPatch # (p ^. _NgramsPatch <> q ^. _NgramsPatch)
 instance Monoid NgramsPatch where
@@ -160,14 +148,6 @@ instance Transformable NgramsPatch where
   transformWith conflict p q = (_NgramsPatch # p', _NgramsPatch # q')
     where
       (p', q') = transformWith conflict (p ^. _NgramsPatch) (q ^. _NgramsPatch)
-
--- The JSON encoding is untagged, this is OK since the field names are disjoints and thus the encoding is unambiguous.
--- TODO: the empty object should be accepted and treated as mempty.
-deriveJSON (unPrefixUntagged "_") ''NgramsPatch
-makeLenses ''NgramsPatch
-
--- TODO: This instance is simplified since we should either have the fields children and/or list
--- or the fields old and/or new.
 instance ToSchema NgramsPatch where
   declareNamedSchema _ = do
     childrenSch <- declareSchemaRef (Proxy :: Proxy (PatchMSet NgramsTerm))
@@ -182,50 +162,36 @@ instance ToSchema NgramsPatch where
                 , ("old",      nreSch)
                 , ("new",      nreSch)
                 ]
-
 instance Arbitrary NgramsPatch where
   arbitrary = frequency [ (9, NgramsPatch <$> arbitrary <*> (replace <$> arbitrary <*> arbitrary))
                         , (1, NgramsReplace <$> arbitrary <*> arbitrary)
                         ]
-
 instance Serialise NgramsPatch
 
+-- The JSON encoding is untagged, this is OK since the field names are disjoints and thus the encoding is unambiguous.
+-- TODO: the empty object should be accepted and treated as mempty.
+deriveJSON (unPrefixUntagged "_") ''NgramsPatch
+makeLenses ''NgramsPatch
 
-------------------------------------------------------------------------
-type NgramsTableMap = Map NgramsTerm NgramsRepoElement
-
-
-newtype NgramsTablePatch = NgramsTablePatch (PatchMap NgramsTerm NgramsPatch)
-  deriving (Eq, Show, Generic, ToJSON, FromJSON, Semigroup, Monoid, Validity, Transformable)
-
-instance Serialise NgramsTablePatch
-instance Serialise (PatchMap NgramsTerm NgramsPatch)
-
-instance FromField NgramsTablePatch
-  where
-    fromField = fromField'
-
-instance FromField (PatchMap SchemaNgrams.NgramsType (PatchMap NodeId NgramsTablePatch))
+_NgramsPatch :: Iso' NgramsPatch NgramsPatchIso
+_NgramsPatch = iso unwrap wrap
   where
-    fromField = fromField'
-
-
-
-type PatchedNgramsPatch = Maybe NgramsRepoElement
-type instance Patched NgramsPatch = PatchedNgramsPatch
+    unwrap (NgramsPatch c l) = Mod $ PairPatch (c, l)
+    unwrap (NgramsReplace o n) = replace o n
+    wrap x =
+      case unMod x of
+        Just (PairPatch (c, l)) -> NgramsPatch c l
+        Nothing -> NgramsReplace (x ^? old . _Just) (x ^? new . _Just)
 
-type PatchedNgramsTablePatch = Map NgramsTerm PatchedNgramsPatch
-  -- ~ Patched (PatchMap NgramsTerm NgramsPatch)
-type instance Patched NgramsTablePatch = PatchedNgramsTablePatch
 
-makePrisms ''NgramsTablePatch
-instance ToSchema  (PatchMap NgramsTerm NgramsPatch)
-instance ToSchema  NgramsTablePatch
+-- TODO: This instance is simplified since we should either have the fields children and/or list
+-- or the fields old and/or new.
 
-instance Applicable NgramsTablePatch (Maybe NgramsTableMap) where
-  applicable p = applicable (p ^. _NgramsTablePatch)
+type NgramsPatchIso =
+  MaybePatch NgramsRepoElement (PairPatch (PatchMSet NgramsTerm) (Replace ListType))
 
 
+------------------------------------------------------------------------
 
 type ConflictResolutionNgramsPatch =
   ( ConflictResolutionReplace (Maybe NgramsRepoElement)
@@ -237,8 +203,8 @@ type ConflictResolutionNgramsPatch =
 type instance ConflictResolution NgramsPatch =
   ConflictResolutionNgramsPatch
 
-type instance ConflictResolution NgramsTablePatch =
-  NgramsTerm -> ConflictResolutionNgramsPatch
+type PatchedNgramsPatch = Maybe NgramsRepoElement
+type instance Patched NgramsPatch = PatchedNgramsPatch
 
 instance Applicable (PairPatch (PatchMSet NgramsTerm) (Replace ListType)) NgramsRepoElement where
   applicable (PairPatch (c, l)) n = applicable c (n ^. nre_children) <> applicable l (n ^. nre_list)
@@ -254,16 +220,33 @@ instance Action NgramsPatch (Maybe NgramsRepoElement) where
   act p = act (p ^. _NgramsPatch)
 
 
-type NgramsPatchIso =
-  MaybePatch NgramsRepoElement (PairPatch (PatchMSet NgramsTerm) (Replace ListType))
 
-_NgramsPatch :: Iso' NgramsPatch NgramsPatchIso
-_NgramsPatch = iso unwrap wrap
+newtype NgramsTablePatch = NgramsTablePatch (PatchMap NgramsTerm NgramsPatch)
+  deriving (Eq, Show, Generic, ToJSON, FromJSON, Semigroup, Monoid, Validity, Transformable)
+
+instance Serialise NgramsTablePatch
+instance Serialise (PatchMap NgramsTerm NgramsPatch)
+instance FromField NgramsTablePatch
   where
-    unwrap (NgramsPatch c l) = Mod $ PairPatch (c, l)
-    unwrap (NgramsReplace o n) = replace o n
-    wrap x =
-      case unMod x of
-        Just (PairPatch (c, l)) -> NgramsPatch c l
-        Nothing -> NgramsReplace (x ^? old . _Just) (x ^? new . _Just)
+    fromField = fromField'
+instance FromField (PatchMap SchemaNgrams.NgramsType (PatchMap NodeId NgramsTablePatch))
+  where
+    fromField = fromField'
+
+
 
+type PatchedNgramsTablePatch = Map NgramsTerm PatchedNgramsPatch
+  -- ~ Patched (PatchMap NgramsTerm NgramsPatch)
+type instance Patched NgramsTablePatch = PatchedNgramsTablePatch
+
+makePrisms ''NgramsTablePatch
+instance ToSchema  (PatchMap NgramsTerm NgramsPatch)
+instance ToSchema  NgramsTablePatch
+
+instance Applicable NgramsTablePatch (Maybe NgramsTableMap) where
+  applicable p = applicable (p ^. _NgramsTablePatch)
+
+
+
+type instance ConflictResolution NgramsTablePatch =
+  NgramsTerm -> ConflictResolutionNgramsPatch