Rename ListType constructors to align with the frontend

parent 67d296e1
......@@ -157,7 +157,7 @@ mkNgramsElement ngrams list parent children =
instance ToSchema NgramsElement
instance Arbitrary NgramsElement where
arbitrary = elements [mkNgramsElement "sport" GraphList Nothing mempty]
arbitrary = elements [mkNgramsElement "sport" GraphTerm Nothing mempty]
------------------------------------------------------------------------
newtype NgramsTable = NgramsTable [NgramsElement]
......@@ -199,18 +199,18 @@ toNgramsElement ns = map toNgramsElement' ns
mockTable :: NgramsTable
mockTable = NgramsTable
[ mkNgramsElement "animal" GraphList Nothing (mSetFromList ["dog", "cat"])
, mkNgramsElement "cat" GraphList (Just "animal") mempty
, mkNgramsElement "cats" StopList Nothing mempty
, mkNgramsElement "dog" GraphList (Just "animal")(mSetFromList ["dogs"])
, mkNgramsElement "dogs" StopList (Just "dog") mempty
, mkNgramsElement "fox" GraphList Nothing mempty
, mkNgramsElement "object" CandidateList Nothing mempty
, mkNgramsElement "nothing" StopList Nothing mempty
, mkNgramsElement "organic" GraphList Nothing (mSetFromList ["flower"])
, mkNgramsElement "flower" GraphList (Just "organic") mempty
, mkNgramsElement "moon" CandidateList Nothing mempty
, mkNgramsElement "sky" StopList Nothing mempty
[ mkNgramsElement "animal" GraphTerm Nothing (mSetFromList ["dog", "cat"])
, mkNgramsElement "cat" GraphTerm (Just "animal") mempty
, mkNgramsElement "cats" StopTerm Nothing mempty
, mkNgramsElement "dog" GraphTerm (Just "animal")(mSetFromList ["dogs"])
, mkNgramsElement "dogs" StopTerm (Just "dog") mempty
, mkNgramsElement "fox" GraphTerm Nothing mempty
, mkNgramsElement "object" CandidateTerm Nothing mempty
, mkNgramsElement "nothing" StopTerm Nothing mempty
, mkNgramsElement "organic" GraphTerm Nothing (mSetFromList ["flower"])
, mkNgramsElement "flower" GraphTerm (Just "organic") mempty
, mkNgramsElement "moon" CandidateTerm Nothing mempty
, mkNgramsElement "sky" StopTerm Nothing mempty
]
instance Arbitrary NgramsTable where
......@@ -501,7 +501,7 @@ instance Arbitrary a => Arbitrary (Versioned a) where
type NgramsIdPatch = Patch NgramsId NgramsPatch
ngramsPatch :: Int -> NgramsPatch
ngramsPatch n = NgramsPatch (DM.fromList [(1, StopList)]) (Set.fromList [n]) Set.empty
ngramsPatch n = NgramsPatch (DM.fromList [(1, StopTerm)]) (Set.fromList [n]) Set.empty
toEdit :: NgramsId -> NgramsPatch -> Edit NgramsId NgramsPatch
toEdit n p = Edit n p
......@@ -553,8 +553,8 @@ ngramError nne = throwError $ _NgramError # nne
{-
-- TODO: Replace.old is ignored which means that if the current list
-- `GraphList` and that the patch is `Replace CandidateList StopList` then
-- the list is going to be `StopList` while it should keep `GraphList`.
-- `GraphTerm` and that the patch is `Replace CandidateTerm StopTerm` then
-- the list is going to be `StopTerm` while it should keep `GraphTerm`.
-- However this should not happen in non conflicting situations.
mkListsUpdate :: NgramsType -> NgramsTablePatch -> [(NgramsTypeId, NgramsTerm, ListTypeId)]
mkListsUpdate nt patches =
......
......@@ -87,7 +87,7 @@ type HashId = Text
type TypeId = Int
-- TODO multiple ListType declaration, remove it
data ListType = StopList | CandidateList | GraphList
data ListType = StopTerm | CandidateTerm | GraphTerm
deriving (Generic, Eq, Ord, Show, Read, Enum, Bounded)
instance ToJSON ListType
......@@ -103,9 +103,9 @@ instance FromHttpApiData ListType where
type ListTypeId = Int
listTypeId :: ListType -> ListTypeId
listTypeId StopList = 0
listTypeId CandidateList = 1
listTypeId GraphList = 2
listTypeId StopTerm = 0
listTypeId CandidateTerm = 1
listTypeId GraphTerm = 2
fromListTypeId :: ListTypeId -> Maybe ListType
fromListTypeId i = lookup i $ fromList [ (listTypeId l, l) | l <- [minBound..maxBound]]
......
......@@ -317,7 +317,7 @@ flowListUser uId cId ngsM _n = do
trace ("flowListBase" <> show lId) flowListBase lId ngsM
putListNgrams lId NgramsTerms $
[ mkNgramsElement (tficf_ngramsTerms ng) GraphList Nothing mempty
[ mkNgramsElement ng GraphTerm Nothing mempty
| ng <- ngs
]
......@@ -327,7 +327,7 @@ flowListUser uId cId ngsM _n = do
ngrams2list :: Map NgramsIndexed (Map NgramsType a)
-> [(ListType, (NgramsType, NgramsIndexed))]
ngrams2list m =
[ (CandidateList, (t, ng))
[ (CandidateTerm, (t, ng))
| (ng, tm) <- DM.toList m
, t <- DM.keys tm
]
......@@ -335,7 +335,7 @@ ngrams2list m =
ngrams2list' :: Map NgramsIndexed (Map NgramsType a)
-> Map NgramsType [NgramsElement]
ngrams2list' m = fromListWith (<>)
[ (t, [mkNgramsElement (_ngramsTerms $ _ngrams ng) CandidateList Nothing mempty])
[ (t, [mkNgramsElement (_ngramsTerms $ _ngrams ng) CandidateTerm Nothing mempty])
| (ng, tm) <- DM.toList m
, t <- DM.keys tm
]
......
......@@ -54,10 +54,10 @@ data DocumentIdWithNgrams a =
, document_ngrams :: Map (NgramsT Ngrams) Int
} deriving (Show)
-- | TODO for now, list Type is CandidateList because Graph Terms
-- | TODO for now, list Type is CandidateTerm because Graph Terms
-- have to be detected in next step in the flow
insertToNodeNgrams :: Map NgramsIndexed (Map NgramsType (Map NodeId Int)) -> Cmd err Int
insertToNodeNgrams m = insertNodeNgrams [ NodeNgram n (_ngramsId ng) Nothing (ngramsTypeId t) (listTypeId CandidateList) (fromIntegral i)
insertToNodeNgrams m = insertNodeNgrams [ NodeNgram n (_ngramsId ng) Nothing (ngramsTypeId t) (listTypeId CandidateTerm) (fromIntegral i)
| (ng, t2n2i) <- DM.toList m
, (t, n2i) <- DM.toList t2n2i
, (n, i) <- DM.toList n2i
......
......@@ -65,7 +65,7 @@ getNgramsByDoc cId lId =
getNgramsByDocDb :: CorpusId -> ListId -> Cmd err [(NodeId, NgramsId, Text, Int)]
getNgramsByDocDb cId lId = runPGSQuery query params
where
params = (cId, lId, listTypeId GraphList, ngramsTypeId NgramsTerms)
params = (cId, lId, listTypeId GraphTerm, ngramsTypeId NgramsTerms)
query = [sql|
-- TODO add CTE
......@@ -208,7 +208,7 @@ getNgramsElementsWithParentNodeId nId = do
ns <- getNgramsWithParentNodeId nId
pure $ fromListWith (<>)
[ (maybe (panic "error") identity $ fromNgramsTypeId nt,
[mkNgramsElement ng CandidateList Nothing mempty])
[mkNgramsElement ng CandidateTerm Nothing mempty])
| (_,(nt,ng)) <- ns
]
......
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