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