Commit 053aa477 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[Types] ready for Env

parent 9a63f1ad
...@@ -53,6 +53,7 @@ import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams ...@@ -53,6 +53,7 @@ import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
------------------------------------------------------------------------ ------------------------------------------------------------------------
type QueryParamR = QueryParam' '[Required, Strict]
------------------------------------------------------------------------ ------------------------------------------------------------------------
--data FacetFormat = Table | Chart --data FacetFormat = Table | Chart
...@@ -251,16 +252,16 @@ toNgramsElement ns = map toNgramsElement' ns ...@@ -251,16 +252,16 @@ toNgramsElement ns = map toNgramsElement' ns
mockTable :: NgramsTable mockTable :: NgramsTable
mockTable = NgramsTable mockTable = NgramsTable
[ mkNgramsElement "animal" MapTerm Nothing (mSetFromList ["dog", "cat"]) [ mkNgramsElement "animal" MapTerm Nothing (mSetFromList ["dog", "cat"])
, mkNgramsElement "cat" MapTerm (rp "animal") mempty , mkNgramsElement "cat" MapTerm (rp "animal") mempty
, mkNgramsElement "cats" StopTerm Nothing mempty , mkNgramsElement "cats" StopTerm Nothing mempty
, mkNgramsElement "dog" MapTerm (rp "animal") (mSetFromList ["dogs"]) , mkNgramsElement "dog" MapTerm (rp "animal") (mSetFromList ["dogs"])
, mkNgramsElement "dogs" StopTerm (rp "dog") mempty , mkNgramsElement "dogs" StopTerm (rp "dog") mempty
, mkNgramsElement "fox" MapTerm Nothing mempty , mkNgramsElement "fox" MapTerm Nothing mempty
, mkNgramsElement "object" CandidateTerm Nothing mempty , mkNgramsElement "object" CandidateTerm Nothing mempty
, mkNgramsElement "nothing" StopTerm Nothing mempty , mkNgramsElement "nothing" StopTerm Nothing mempty
, mkNgramsElement "organic" MapTerm Nothing (mSetFromList ["flower"]) , mkNgramsElement "organic" MapTerm Nothing (mSetFromList ["flower"])
, mkNgramsElement "flower" MapTerm (rp "organic") mempty , mkNgramsElement "flower" MapTerm (rp "organic") mempty
, mkNgramsElement "moon" CandidateTerm Nothing mempty , mkNgramsElement "moon" CandidateTerm Nothing mempty
, mkNgramsElement "sky" StopTerm Nothing mempty , mkNgramsElement "sky" StopTerm Nothing mempty
] ]
...@@ -711,6 +712,8 @@ initMockRepo = Repo 1 s [] ...@@ -711,6 +712,8 @@ initMockRepo = Repo 1 s []
$ Map.fromList $ Map.fromList
[ (n ^. ne_ngrams, ngramsElementToRepo n) | n <- mockTable ^. _NgramsTable ] [ (n ^. ne_ngrams, ngramsElementToRepo n) | n <- mockTable ^. _NgramsTable ]
--------------------
data RepoEnv = RepoEnv data RepoEnv = RepoEnv
{ _renv_var :: !(MVar NgramsRepo) { _renv_var :: !(MVar NgramsRepo)
, _renv_saver :: !(IO ()) , _renv_saver :: !(IO ())
...@@ -750,8 +753,7 @@ type RepoCmdM env err m = ...@@ -750,8 +753,7 @@ type RepoCmdM env err m =
, HasConfig env , HasConfig env
) )
------------------------------------------------------------------------
type QueryParamR = QueryParam' '[Required, Strict]
-- Instances -- Instances
......
...@@ -12,19 +12,22 @@ Portability : POSIX ...@@ -12,19 +12,22 @@ Portability : POSIX
module Gargantext.Core.NodeStory where module Gargantext.Core.NodeStory where
import Codec.Serialise (Serialise())
import Control.Lens (makeLenses, makePrisms, Getter, Iso', iso, from, (.~), (?=), (#), to, folded, {-withIndex, ifolded,-} view, use, (^.), (^?), (%~), (.~), (%=), at, _Just, Each(..), itraverse_, both, forOf_, (?~))
import Data.Aeson hiding ((.=))
import Data.IntMap (IntMap) import Data.IntMap (IntMap)
import qualified Data.IntMap as Dict import Data.IntMap as Bibliotheque
import Data.Map (Map) import Data.Map (Map)
import Data.Map as Map import Data.Map as Map
import Data.Monoid
import GHC.Generics (Generic)
import Gargantext.API.Ngrams.Types import Gargantext.API.Ngrams.Types
import Gargantext.Core.Types (ListType(..), ListId, NodeId) import Gargantext.Core.Types (ListType(..), ListId, NodeId)
import Data.IntMap as Bibliotheque
import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
import Gargantext.Prelude
import GHC.Generics (Generic)
import Data.Aeson hiding ((.=))
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixUntagged, unPrefixSwagger, wellNamedSchema) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixUntagged, unPrefixSwagger, wellNamedSchema)
import Gargantext.Prelude
import qualified Data.IntMap as Dict
import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
-- TODO : repo Migration -- TODO : repo Migration
repoMigration :: (s -> s') -> (p -> p') -> Repo s p -> NodeStory s' p' repoMigration :: (s -> s') -> (p -> p') -> Repo s p -> NodeStory s' p'
...@@ -36,6 +39,8 @@ data NodeStory s p = NodeStory { unNodeStory :: Map NodeId (Archive s p) } ...@@ -36,6 +39,8 @@ data NodeStory s p = NodeStory { unNodeStory :: Map NodeId (Archive s p) }
deriving (Generic, Show) deriving (Generic, Show)
instance (FromJSON s, FromJSON p) => FromJSON (NodeStory s p) instance (FromJSON s, FromJSON p) => FromJSON (NodeStory s p)
instance (ToJSON s, ToJSON p) => ToJSON (NodeStory s p)
instance (Serialise s, Serialise p) => Serialise (NodeStory s p)
data Archive s p = Archive data Archive s p = Archive
{ _a_version :: !Version { _a_version :: !Version
...@@ -45,9 +50,12 @@ data Archive s p = Archive ...@@ -45,9 +50,12 @@ data Archive s p = Archive
} }
deriving (Generic, Show) deriving (Generic, Show)
instance (Serialise s, Serialise p) => Serialise (Archive s p)
-- TODO Semigroup instance for unions -- TODO Semigroup instance for unions
type NodeListStory = NodeStory NgramsState' NgramsStatePatch' type NodeListStory = NodeStory NgramsState' NgramsStatePatch'
type NgramsState' = Map TableNgrams.NgramsType NgramsTableMap type NgramsState' = Map TableNgrams.NgramsType NgramsTableMap
type NgramsStatePatch' = PatchMap TableNgrams.NgramsType NgramsTablePatch type NgramsStatePatch' = PatchMap TableNgrams.NgramsType NgramsTablePatch
...@@ -57,3 +65,28 @@ instance (FromJSON s, FromJSON p) => FromJSON (Archive s p) where ...@@ -57,3 +65,28 @@ instance (FromJSON s, FromJSON p) => FromJSON (Archive s p) where
instance (ToJSON s, ToJSON p) => ToJSON (Archive s p) where instance (ToJSON s, ToJSON p) => ToJSON (Archive s p) where
toJSON = genericToJSON $ unPrefix "_a_" toJSON = genericToJSON $ unPrefix "_a_"
toEncoding = genericToEncoding $ unPrefix "_a_" toEncoding = genericToEncoding $ unPrefix "_a_"
------------------------------------------------------------------------
initNodeStory :: Monoid s => NodeStory s p
initNodeStory = NodeStory $ Map.singleton 1 initArchive
initArchive :: Monoid s => Archive s p
initArchive = Archive 1 mempty []
initNodeListStoryMock :: NodeListStory
initNodeListStoryMock = NodeStory $ Map.singleton nodeListId archive
where
nodeListId = 10
archive = Archive 1 ngramsTableMap []
ngramsTableMap = Map.singleton TableNgrams.NgramsTerms
$ Map.fromList
[ (n ^. ne_ngrams, ngramsElementToRepo n)
| n <- mockTable ^. _NgramsTable
]
------------------------------------------------------------------------
{-
data NodeStoryEnv = NodeStoryEnv
{ _nse_var :: !(MVar
-}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment