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.Database.Utils (connectGargandb)
  72 import Gargantext.Database.Node
  73 import Gargantext.Prelude
  74 import Database.PostgreSQL.Simple (Connection)
  75 import Data.Text (Text, pack)
  76 import Opaleye hiding (FromField)
  77 import Data.Aeson
  78 import Data.List (last, concat)
  79
  80 --type UserId = Int
  81 --type NodeId = Int
  82
  83 -- List of NodeId
  84 -- type PWD a = PWD UserId [a]
  85 type PWD = [NodeId]
  86 --data PWD' a = a | PWD' [a]
  87
  88 -- | TODO get Children or Node
  89 get :: Connection -> PWD -> IO [Node Value]
  90 get _ [] = pure []
  91 get conn pwd = runQuery conn $ selectNodesWithParentID (last pwd)
  92
  93 -- | Home, need to filter with UserId
  94 home :: Connection -> IO PWD
  95 home c = map node_id <$> getNodesWithParentId c 0 Nothing
  96
  97 -- | ls == get Children
  98 ls :: Connection -> PWD -> IO [Node Value]
  99 ls = get
 100
 101 tree :: Connection -> PWD -> IO [Node Value]
 102 tree c p = do
 103   ns <- get c p
 104   children <- mapM (\p' -> get c [p']) $ map node_id ns
 105   pure $ ns <> (concat children)
 106
 107
 108 -- | TODO
 109 post :: Connection -> PWD -> [NodeWrite'] -> IO Int64
 110 post _ [] _   = pure 0
 111 post _ _ []   = pure 0
 112 post c pth ns = mkNode c (last pth) ns
 113
 114 --postR :: Connection -> PWD -> [NodeWrite'] -> IO [Int]
 115 --postR _ [] _   = pure [0]
 116 --postR _ _ []   = pure [0]
 117 --postR c pth ns = mkNodeR c (last pth) ns
 118 --
 119
 120 --rm :: Connection -> PWD -> [NodeId] -> IO Int
 121 --rm = del
 122
 123 del :: Connection -> [NodeId] -> IO Int
 124 del _ [] = pure 0
 125 del c ns = deleteNodes c ns
 126
 127 -- | TODO
 128 --put :: Connection -> PWD -> [a] -> IO Int64
 129 --put = undefined
 130
 131 -- | TODO
 132 -- cd (Home UserId) | (Node NodeId)
 133 -- cd Path
 134 -- jump NodeId
 135 -- touch Dir
 136
 137 --------------------------------------------------------------
 138 -- Tests
 139 --------------------------------------------------------------
 140
 141 home' :: IO PWD
 142 home' = do
 143   c <- connectGargandb "gargantext.ini"
 144   home c
 145
 146 ls' :: IO [Node Value]
 147 ls' = do
 148   c <- connectGargandb "gargantext.ini"
 149   h <- home c
 150   ls c h
 151
 152 tree' :: IO [Node Value]
 153 tree' = do
 154   c <- connectGargandb "gargantext.ini"
 155   h <- home c
 156   tree c h
 157
 158 post' :: IO [Int]
 159 post'  = do
 160   c   <- connectGargandb "gargantext.ini"
 161   pid <- last <$> home c
 162   let uid = 1
 163   postNode c uid pid ( Node' NodeCorpus  (pack "Premier corpus") (toJSON (pack "{}"::Text)) [ Node' Document (pack "Doc1") (toJSON (pack "{}" :: Text)) []
 164                                                           , Node' Document (pack "Doc2") (toJSON (pack "{}" :: Text)) []
 165                                                           , Node' Document (pack "Doc3") (toJSON (pack "{}" :: Text)) []
 166                                                           ]
 167                      )
 168
 169 type CorpusName = Text
 170
 171 -- |
 172 -- myCorpus <- Prelude.map doc2hyperdataDocument <$> toDocs <$> snd <$> readCsv "doc/corpus_imt/Gargantext_Corpus_small.csv"
 173 -- There is an error in the CSV parsing...
 174 -- let myCorpus' = Prelude.filter (\n -> T.length (maybe "" identity (hyperdataDocument_title n)) > 30) myCorpus
 175
 176 postCorpus :: ToJSON a => CorpusName -> (a -> Text) -> [a] -> IO [Int]
 177 postCorpus corpusName title ns = do
 178   c   <- connectGargandb "gargantext.ini"
 179   pid <- last <$> home c
 180   let uid = 1
 181   postNode c uid pid ( Node' NodeCorpus  corpusName (toJSON (pack "{}"::Text))
 182                              (map (\n -> Node' Document (title n) (toJSON n) []) ns)
 183                      )
 184
 185 -- |
 186 -- import IMTClient as C
 187 -- postAnnuaire "Annuaire IMT" (\n -> (maybe "" identity (C.prenom n)) <> " " <> (maybe "" identity (C.nom n))) (take 30 annuaire)
 188 postAnnuaire :: ToJSON a => CorpusName -> (a -> Text) -> [a] -> IO [Int]
 189 postAnnuaire corpusName title ns = do
 190   c   <- connectGargandb "gargantext.ini"
 191   pid <- last <$> home c
 192   let uid = 1
 193   postNode c uid pid ( Node' Annuaire  corpusName (toJSON (pack "{}"::Text))
 194                              (map (\n -> Node' UserPage (title n) (toJSON n) []) ns)
 195                      )
 196
 197
 198 del' :: [NodeId] -> IO Int
 199 del' ns = do
 200   c <- connectGargandb "gargantext.ini"
 201   del c ns
 202
 203