src/Gargantext/Database.hs

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