src/Gargantext/Database/Bashql.hs

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