Commit f7b357a7 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[DOC] stack haddock build ok.

parent ec52b44c
...@@ -236,10 +236,12 @@ ngramsElementFromRepo ...@@ -236,10 +236,12 @@ ngramsElementFromRepo
, _ne_children = c , _ne_children = c
, _ne_ngrams = ngrams , _ne_ngrams = ngrams
, _ne_occurrences = panic "API.Ngrams._ne_occurrences" , _ne_occurrences = panic "API.Ngrams._ne_occurrences"
-- ^ Here we could use 0 if we want to avoid any `panic`. {-
-- Here we could use 0 if we want to avoid any `panic`.
-- It will not happen using getTableNgrams if -- It will not happen using getTableNgrams if
-- getOccByNgramsOnly provides a count of occurrences for -- getOccByNgramsOnly provides a count of occurrences for
-- all the ngrams given. -- all the ngrams given.
-}
} }
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -644,14 +646,14 @@ ngramsTypeFromTabType tabType = ...@@ -644,14 +646,14 @@ ngramsTypeFromTabType tabType =
Institutes -> Ngrams.Institutes Institutes -> Ngrams.Institutes
Terms -> Ngrams.NgramsTerms Terms -> Ngrams.NgramsTerms
_ -> panic $ lieu <> "No Ngrams for this tab" _ -> panic $ lieu <> "No Ngrams for this tab"
-- ^ TODO: This `panic` would disapear with custom NgramsType. -- TODO: This `panic` would disapear with custom NgramsType.
------------------------------------------------------------------------ ------------------------------------------------------------------------
data Repo s p = Repo data Repo s p = Repo
{ _r_version :: Version { _r_version :: Version
, _r_state :: s , _r_state :: s
, _r_history :: [p] , _r_history :: [p]
-- ^ first patch in the list is the most recent -- first patch in the list is the most recent
} }
deriving (Generic) deriving (Generic)
......
...@@ -297,7 +297,7 @@ type TreeApi = Summary " Tree API" ...@@ -297,7 +297,7 @@ type TreeApi = Summary " Tree API"
instance HasNodeError ServantErr where instance HasNodeError ServantErr where
_NodeError = prism' mk (const Nothing) -- $ panic "HasNodeError ServantErr: not a prism") _NodeError = prism' mk (const Nothing) -- panic "HasNodeError ServantErr: not a prism")
where where
e = "Gargantext NodeError: " e = "Gargantext NodeError: "
mk NoListFound = err404 { errBody = e <> "No list found" } mk NoListFound = err404 { errBody = e <> "No list found" }
...@@ -315,7 +315,7 @@ instance HasNodeError ServantErr where ...@@ -315,7 +315,7 @@ instance HasNodeError ServantErr where
-- TODO(orphan): There should be a proper APIError data type with a case TreeError. -- TODO(orphan): There should be a proper APIError data type with a case TreeError.
instance HasTreeError ServantErr where instance HasTreeError ServantErr where
_TreeError = prism' mk (const Nothing) -- $ panic "HasTreeError ServantErr: not a prism") _TreeError = prism' mk (const Nothing) -- panic "HasTreeError ServantErr: not a prism")
where where
e = "TreeError: " e = "TreeError: "
mk NoRoot = err404 { errBody = e <> "Root node not found" } mk NoRoot = err404 { errBody = e <> "Root node not found" }
......
...@@ -71,13 +71,13 @@ data SendEmailType = SendEmailViaAws ...@@ -71,13 +71,13 @@ data SendEmailType = SendEmailViaAws
data Settings = Settings data Settings = Settings
{ _allowedOrigin :: ByteString -- ^ allowed origin for CORS { _allowedOrigin :: ByteString -- allowed origin for CORS
, _allowedHost :: ByteString -- ^ allowed host for CORS , _allowedHost :: ByteString -- allowed host for CORS
, _appPort :: PortNumber , _appPort :: PortNumber
, _logLevelLimit :: LogLevel -- ^ log level from the monad-logger package , _logLevelLimit :: LogLevel -- log level from the monad-logger package
-- , _dbServer :: Text -- , _dbServer :: Text
-- ^ this is not used yet -- ^ this is not used yet
, _jwtSecret :: Jose.Jwk -- ^ key from the jose-jwt package , _jwtSecret :: Jose.Jwk -- key from the jose-jwt package
, _sendLoginEmails :: SendEmailType , _sendLoginEmails :: SendEmailType
, _scrapydUrl :: BaseUrl , _scrapydUrl :: BaseUrl
, _fileFolder :: FilePath , _fileFolder :: FilePath
...@@ -195,22 +195,22 @@ mkRepoSaver repo_var = mkDebounce settings ...@@ -195,22 +195,22 @@ mkRepoSaver repo_var = mkDebounce settings
settings = defaultDebounceSettings settings = defaultDebounceSettings
{ debounceFreq = 1000000 -- 1 second { debounceFreq = 1000000 -- 1 second
, debounceAction = withMVar repo_var repoSaverAction , debounceAction = withMVar repo_var repoSaverAction
-- ^ Here this not only `readMVar` but `takeMVar`. -- Here this not only `readMVar` but `takeMVar`.
-- Namely while repoSaverAction is saving no other change -- Namely while repoSaverAction is saving no other change
-- can be made to the MVar. -- can be made to the MVar.
-- This might be not efficent and thus reconsidered later. -- This might be not efficent and thus reconsidered later.
-- However this enables to safely perform a *final* save. -- However this enables to safely perform a *final* save.
-- See `cleanEnv`. -- See `cleanEnv`.
-- Future work: -- Future work:
-- * Add a new MVar just for saving. -- Add a new MVar just for saving.
} }
readRepoEnv :: IO RepoEnv readRepoEnv :: IO RepoEnv
readRepoEnv = do readRepoEnv = do
-- | Does file exist ? :: Bool -- Does file exist ? :: Bool
repoFile <- doesFileExist repoSnapshot repoFile <- doesFileExist repoSnapshot
-- | Is file not empty ? :: Bool -- Is file not empty ? :: Bool
repoExists <- if repoFile repoExists <- if repoFile
then (>0) <$> getFileSize repoSnapshot then (>0) <$> getFileSize repoSnapshot
else pure False else pure False
......
...@@ -172,7 +172,6 @@ data OrderBy = DateAsc | DateDesc ...@@ -172,7 +172,6 @@ data OrderBy = DateAsc | DateDesc
| TitleAsc | TitleDesc | TitleAsc | TitleDesc
| ScoreDesc | ScoreAsc | ScoreDesc | ScoreAsc
deriving (Generic, Enum, Bounded, Read, Show) deriving (Generic, Enum, Bounded, Read, Show)
-- | NgramCoun
instance FromHttpApiData OrderBy instance FromHttpApiData OrderBy
where where
......
...@@ -106,7 +106,7 @@ flowCorpusDebat u n l fp = do ...@@ -106,7 +106,7 @@ flowCorpusDebat u n l fp = do
flowCorpusFile :: FlowCmdM env ServantErr m flowCorpusFile :: FlowCmdM env ServantErr m
=> Username -> CorpusName => Username -> CorpusName
-> Limit -- ^ Limit the number of docs (for dev purpose) -> Limit -- Limit the number of docs (for dev purpose)
-> TermType Lang -> FileFormat -> FilePath -> TermType Lang -> FileFormat -> FilePath
-> m CorpusId -> m CorpusId
flowCorpusFile u n l la ff fp = do flowCorpusFile u n l la ff fp = do
......
...@@ -180,10 +180,10 @@ queryInsert = [sql| ...@@ -180,10 +180,10 @@ queryInsert = [sql|
-- | When documents are inserted -- | When documents are inserted
-- ReturnType after insertion -- ReturnType after insertion
data ReturnId = ReturnId { reInserted :: Bool -- ^ if the document is inserted (True: is new, False: is not new) data ReturnId = ReturnId { reInserted :: Bool -- if the document is inserted (True: is new, False: is not new)
, reId :: NodeId -- ^ always return the id of the document (even new or not new) , reId :: NodeId -- always return the id of the document (even new or not new)
-- this is the uniq id in the database -- this is the uniq id in the database
, reUniqId :: Text -- ^ Hash Id with concatenation of hash parameters , reUniqId :: Text -- Hash Id with concatenation of hash parameters
} deriving (Show, Generic) } deriving (Show, Generic)
instance FromRow ReturnId where instance FromRow ReturnId where
......
...@@ -429,13 +429,16 @@ data NodeType = NodeUser ...@@ -429,13 +429,16 @@ data NodeType = NodeUser
| NodeFolder | NodeFolder
| NodeCorpus | NodeCorpusV3 | NodeDocument | NodeCorpus | NodeCorpusV3 | NodeDocument
| NodeAnnuaire | NodeContact | NodeAnnuaire | NodeContact
-- | NodeOccurrences
| NodeGraph | NodeGraph
| NodeDashboard | NodeChart | NodeDashboard | NodeChart
-- | Classification | NodeList | NodeListModel deriving (Show, Read, Eq, Generic, Bounded, Enum)
| NodeList | NodeListModel
{-
-- | Metrics -- | Metrics
deriving (Show, Read, Eq, Generic, Bounded, Enum) -- | NodeOccurrences
-- | Classification
-}
allNodeTypes :: [NodeType] allNodeTypes :: [NodeType]
allNodeTypes = [minBound ..] allNodeTypes = [minBound ..]
......
...@@ -27,13 +27,13 @@ group :: [TokenTag] -> [TokenTag] ...@@ -27,13 +27,13 @@ group :: [TokenTag] -> [TokenTag]
group [] = [] group [] = []
group ntags = group2 NP NP group ntags = group2 NP NP
$ group2 NP VB $ group2 NP VB
-- $ group2 NP IN -- group2 NP IN
-- - $ group2 IN DT -- group2 IN DT
$ group2 VB NP $ group2 VB NP
$ group2 JJ NP $ group2 JJ NP
$ group2 NP JJ $ group2 NP JJ
$ group2 JJ JJ $ group2 JJ JJ
-- - $ group2 JJ CC -- group2 JJ CC
$ ntags $ ntags
------------------------------------------------------------------------ ------------------------------------------------------------------------
......
...@@ -79,8 +79,8 @@ getPhylo _phyloId _lId l f b l' ms x y z ts s o d b' = do ...@@ -79,8 +79,8 @@ getPhylo _phyloId _lId l f b l' ms x y z ts s o d b' = do
fs' = maybe (Just []) (\p -> Just [p]) $ SmallBranch <$> (SBParams <$> x <*> y <*> z) fs' = maybe (Just []) (\p -> Just [p]) $ SmallBranch <$> (SBParams <$> x <*> y <*> z)
so = (,) <$> s <*> o so = (,) <$> s <*> o
q = initPhyloQueryView l f b l' ms fs' ts so d b' q = initPhyloQueryView l f b l' ms fs' ts so d b'
-- | TODO remove phylo for real data here
pure (toPhyloView q phylo) pure (toPhyloView q phylo)
-- TODO remove phylo for real data here
------------------------------------------------------------------------ ------------------------------------------------------------------------
{- {-
......
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