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