src/Gargantext/Database.hs

   1 {-|
   2 Module      : Gargantext.Database
   3 Description : Main commands of BASHQL a Domain Specific Language to deal with Gargantext Database.
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 * BASHQL = functional (Bash * SQL)
  11
  12 * Which language to chose when working with a database ? To make it
  13 simple, instead of all common Object Relational Mapping (ORM) [1]
  14 strategy used nowadays inspired more by object logic than functional
  15 logic, the semantics of BASHQL with focus on the function first.
  16
  17 * BASHQL focus on the function, i.e. use bash language function name,
  18 and make it with SQL behind the scene. Then BASHQL is inspired more
  19 by Bash language [2] than SQL and then follows its main commands as
  20 specification and documentation.
  21
  22 * Main arguments:
  23   1. Theoritical: database and FileSystems are each thought as a single
  24   category, assumption based on theoretical work on databases by David Spivak [0].
  25   2. Practical argument: basic bash commands are a daily practice among
  26   developper community.
  27
  28 * How to help ?
  29   1. Choose a command you like in Bash
  30   2. Implement it in Haskell-SQL according to Gargantext Shema (Tree like
  31   filesystem)
  32   3. Translate it in BASHQL (follow previous implementations)
  33   4. Make a pull request    (enjoy the community)
  34
  35 * Implementation strategy: Functional adapations are made to the
  36 gargantext languages options and SQL optimization are done continuously
  37 during the project. For the Haskellish part, you may be inspired by
  38 Turtle implementation written by Gabriel Gonzales [3] which shows how to
  39 write Haskell bash translations.
  40
  41 * Semantics
  42 - FileSystem is now a NodeSystem where each File is a Node in a Directed Graph (DG).
  43
  44 * References
  45 [0] MIT Press has published "Category theory for the sciences". The book
  46 can also be purchased on Amazon. Here are reviews by the MAA, by the
  47 AMS, and by SIAM.
  48
  49 [1] https://en.wikipedia.org/wiki/Object-relational_mapping
  50
  51 [2] https://en.wikipedia.org/wiki/Bash_(Unix_shell)
  52
  53 [3] https://github.com/Gabriel439/Haskell-Turtle-Library
  54
  55 -}
  56
  57 {-# LANGUAGE NoImplicitPrelude #-}
  58
  59 module Gargantext.Database ( module Gargantext.Database.Utils
  60                            , get
  61                            , ls  , ls'
  62                            , home, home'
  63                            , post, post'
  64                            , del , del'
  65                            , tree, tree'
  66                            , postCorpus, postAnnuaire
  67                            )
  68     where
  69
  70 import Gargantext.Core.Types
  71 import Gargantext.Core.Types.Node
  72 import Gargantext.Database.Utils (connectGargandb)
  73 import Gargantext.Database.Node
  74 import Gargantext.Prelude
  75 import Database.PostgreSQL.Simple (Connection)
  76 import Data.Text (Text, pack)
  77 import Opaleye hiding (FromField)
  78 import Data.Aeson
  79 import Data.ByteString (ByteString)
  80 import Data.List (last, concat)
  81 type UserId = Int
  82 --type NodeId = Int
  83
  84 -- List of NodeId
  85 -- type PWD a = PWD UserId [a]
  86 type PWD = [NodeId]
  87 --data PWD' a = a | PWD' [a]
  88
  89 -- | TODO get Children or Node
  90 get :: Connection -> PWD -> IO [Node Value]
  91 get _ [] = pure []
  92 get conn pwd = runQuery conn $ selectNodesWithParentID (last pwd)
  93
  94 -- | Home, need to filter with UserId
  95 home :: Connection -> IO PWD
  96 home c = map node_id <$> getNodesWithParentId c 0 Nothing
  97
  98 -- | ls == get Children
  99 ls :: Connection -> PWD -> IO [Node Value]
 100 ls = get
 101
 102 tree :: Connection -> PWD -> IO [Node Value]
 103 tree c p = do
 104   ns <- get c p
 105   cs <- mapM (\p' -> get c [p']) $ map node_id ns
 106   pure $ ns <> (concat cs)
 107
 108
 109 -- | TODO
 110 post :: Connection -> PWD -> [NodeWrite'] -> IO Int64
 111 post _ [] _   = pure 0
 112 post _ _ []   = pure 0
 113 post c pth ns = mkNode c (last pth) ns
 114
 115 postR :: Connection -> PWD -> [NodeWrite'] -> IO [Int]
 116 postR _ [] _   = pure [0]
 117 postR _ _ []   = pure [0]
 118 postR c pth ns = mkNodeR c (last pth) ns
 119
 120
 121 rm :: Connection -> PWD -> [NodeId] -> IO Int
 122 rm = del
 123
 124 del :: Connection -> PWD -> [NodeId] -> IO Int
 125 del _ [] _ = pure 0
 126 del _ _ [] = pure 0
 127 del c pth ns = deleteNodes c ns
 128
 129 put :: Connection -> PWD -> [a] -> IO Int64
 130 put = undefined
 131
 132 -- | TODO
 133 -- cd (Home UserId) | (Node NodeId)
 134 -- cd Path
 135 -- jump NodeId
 136 -- touch Dir
 137
 138 --------------------------------------------------------------
 139 -- Tests
 140 --------------------------------------------------------------
 141
 142 home' :: IO PWD
 143 home' = do
 144   c <- connectGargandb "gargantext.ini"
 145   home c
 146
 147 ls' :: IO [Node Value]
 148 ls' = do
 149   c <- connectGargandb "gargantext.ini"
 150   h <- home c
 151   ls c h
 152
 153 tree' :: IO [Node Value]
 154 tree' = do
 155   c <- connectGargandb "gargantext.ini"
 156   h <- home c
 157   tree c h
 158
 159 post' :: IO [Int]
 160 post'  = do
 161   c   <- connectGargandb "gargantext.ini"
 162   pid <- last <$> home c
 163   let uid = 1
 164   postNode c uid pid ( Node' Corpus  (pack "Premier corpus") (toJSON (pack "{}"::Text)) [ Node' Document (pack "Doc1") (toJSON (pack "{}" :: Text)) []
 165                                                           , Node' Document (pack "Doc2") (toJSON (pack "{}" :: Text)) []
 166                                                           , Node' Document (pack "Doc3") (toJSON (pack "{}" :: Text)) []
 167                                                           ]
 168                      )
 169
 170 type CorpusName = Text
 171
 172 -- |
 173 -- myCorpus <- Prelude.map doc2hyperdataDocument <$> toDocs <$> snd <$> readCsv "doc/corpus_imt/Gargantext_Corpus_small.csv"
 174 -- There is an error in the CSV parsing...
 175 -- let myCorpus' = Prelude.filter (\n -> T.length (maybe "" identity (hyperdataDocument_title n)) > 30) myCorpus
 176
 177 postCorpus :: ToJSON a => CorpusName -> (a -> Text) -> [a] -> IO [Int]
 178 postCorpus corpusName title ns = do
 179   c   <- connectGargandb "gargantext.ini"
 180   pid <- last <$> home c
 181   let uid = 1
 182   postNode c uid pid ( Node' Corpus  corpusName (toJSON (pack "{}"::Text))
 183                              (map (\n -> Node' Document (title n) (toJSON n) []) ns)
 184                      )
 185
 186 -- |
 187 -- import IMTClient as C
 188 -- postAnnuaire "Annuaire IMT" (\n -> (maybe "" identity (C.prenom n)) <> " " <> (maybe "" identity (C.nom n))) (take 30 annuaire)
 189 postAnnuaire :: ToJSON a => CorpusName -> (a -> Text) -> [a] -> IO [Int]
 190 postAnnuaire corpusName title ns = do
 191   c   <- connectGargandb "gargantext.ini"
 192   pid <- last <$> home c
 193   let uid = 1
 194   postNode c uid pid ( Node' Annuaire  corpusName (toJSON (pack "{}"::Text))
 195                              (map (\n -> Node' UserPage (title n) (toJSON n) []) ns)
 196                      )
 197
 198
 199
 200 del' :: [NodeId] -> IO Int
 201 del' ns = do
 202   c <- connectGargandb "gargantext.ini"
 203   h <- home c
 204   del c h ns
 205
 206