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