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
  64                                   , ls
  65                                   , home
  66                                   , post
  67                                   , del
  68                                   , mv
  69                                   , put
  70                                   , rename
  71                                   , tree
  72                                   -- , mkCorpus, mkAnnuaire
  73                                   , runCmd'
  74                                  )
  75     where
  76
  77 import Control.Monad.Reader -- (Reader, ask)
  78
  79 import Safe (lastMay)
  80 import Data.Text (Text)
  81 import Data.Aeson
  82 import Data.Aeson.Types
  83 import Data.List (concat, last)
  84
  85 import Gargantext.Core.Types
  86 import Gargantext.Database.Utils (connectGargandb)
  87 import Gargantext.Database.Node
  88 import qualified Gargantext.Database.Node.Update as U (Update(..), update)
  89 import Gargantext.Prelude
  90
  91 import Opaleye hiding (FromField)
  92
  93
  94 -- List of NodeId
  95 -- type PWD a = PWD UserId [a]
  96 type PWD = [NodeId]
  97 --data PWD' a = a | PWD' [a]
  98
  99 rename :: NodeId -> Text -> Cmd [Int]
 100 rename n t = mkCmd $ \conn -> U.update (U.Rename n t) conn
 101
 102 mv :: NodeId -> ParentId -> Cmd [Int]
 103 mv n p = mkCmd $ \conn -> U.update (U.Move n p) conn
 104
 105 -- | TODO get Children or Node
 106 get :: PWD -> Cmd [Node Value]
 107 get []  = pure []
 108 get pwd = Cmd . ReaderT $ \conn -> runQuery conn $ selectNodesWithParentID (last pwd)
 109
 110 -- | Home, need to filter with UserId
 111 home :: Cmd PWD
 112 home = map node_id <$> Cmd (ReaderT (getNodesWithParentId 0 Nothing))
 113
 114 -- | ls == get Children
 115 ls :: PWD -> Cmd [Node Value]
 116 ls = get
 117
 118 tree :: PWD -> Cmd [Node Value]
 119 tree p = do
 120   ns       <- get p
 121   children <- mapM (\n -> get [node_id n]) ns
 122   pure $ ns <> concat children
 123
 124 -- | TODO
 125 post :: PWD -> [NodeWrite'] -> Cmd Int64
 126 post [] _   = pure 0
 127 post _ []   = pure 0
 128 post pth ns = Cmd . ReaderT $ mkNode (Just $ last pth) ns
 129
 130 --postR :: PWD -> [NodeWrite'] -> Cmd [Int]
 131 --postR [] _ _ = pure [0]
 132 --postR _ [] _ = pure [0]
 133 --postR pth ns c = mkNodeR (last pth) ns c
 134
 135 -- | WIP
 136 -- rm : mv to trash
 137 -- del : empty trash
 138 --rm :: Connection -> PWD -> [NodeId] -> IO Int
 139 --rm = del
 140 del :: [NodeId] -> Cmd Int
 141 del [] = pure 0
 142 del ns = deleteNodes ns
 143
 144 -- | TODO
 145 put :: U.Update -> Cmd [Int]
 146 put u = mkCmd $ U.update u
 147
 148 -- | TODO
 149 -- cd (Home UserId) | (Node NodeId)
 150 -- cd Path
 151 -- jump NodeId
 152 -- touch Dir
 153
 154 type Name = Text
 155
 156
 157 --mkCorpus :: ToJSON a => Name -> (a -> Text) -> [a] -> Cmd NewNode
 158 --mkCorpus name title ns = do
 159 --  pid <- home
 160 --
 161 --  let pid' = case lastMay pid of
 162 --        Nothing -> printDebug "No home for" name
 163 --        Just p  -> p
 164 --
 165 --  let uid = 1
 166 --  postNode uid (Just pid') ( Node' NodeCorpus  name emptyObject
 167 --                       (map (\n -> Node' Document (title n) (toJSON n) []) ns)
 168 --                   )
 169 --
 170 ---- |
 171 ---- import IMTClient as C
 172 ---- postAnnuaire "Annuaire IMT" (\n -> (maybe "" identity (C.prenom n)) <> " " <> (maybe "" identity (C.nom n))) (take 30 annuaire)
 173 --mkAnnuaire :: ToJSON a => Name -> (a -> Text) -> [a] -> Cmd NewNode
 174 --mkAnnuaire name title ns = do
 175 --  pid <- lastMay <$> home
 176 --  let pid' = case lastMay pid of
 177 --        Nothing -> printDebug "No home for" name
 178 --        Just p  -> p
 179 --  let uid = 1
 180 --  postNode uid (Just pid') ( Node' Annuaire  name emptyObject
 181 --                       (map (\n -> Node' UserPage (title n) (toJSON n) []) ns)
 182 --                   )
 183
 184 --------------------------------------------------------------
 185 -- |
 186 -- myCorpus <- Prelude.map doc2hyperdataDocument <$> toDocs <$> snd <$> readCsv "doc/corpus_imt/Gargantext_Corpus_small.csv"
 187 -- There is an error in the CSV parsing...
 188 -- let myCorpus' = Prelude.filter (\n -> T.length (maybe "" identity (hyperdataDocument_title n)) > 30) myCorpus
 189
 190 -- corporaOf :: Username -> IO [Corpus]
 191
 192 runCmd' :: Cmd a -> IO a
 193 runCmd' f = connectGargandb "gargantext.ini" >>= \c -> runCmd c f