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