[FIX] merge

devops/docker/Dockerfile

-from fpco/stack-build:lts-14.22
+from fpco/stack-build:lts-14.6
 
 RUN apt-get update && \
     apt-get install -y git libigraph0-dev && \

src/Gargantext/API.hs

@@ -73,16 +73,12 @@ import           Servant
 import           Servant.Auth as SA
 import           Servant.Auth.Server (AuthResult(..))
 import           Servant.Auth.Swagger ()
-import           Servant.HTML.Blaze (HTML)
 --import           Servant.Mock (mock)
 --import           Servant.Job.Server (WithCallbacks)
 import           Servant.Job.Async
-import           Servant.Static.TH.Internal.Server (fileTreeToServer)
-import           Servant.Static.TH.Internal.FileTree (fileTypeToFileTree, FileType(FileTypeFile))
 import           Servant.Swagger
 import           Servant.Swagger.UI
 -- import Servant.API.Stream
-import           Text.Blaze.Html (Html)
 
 --import Gargantext.API.Swagger
 
@@ -321,9 +317,8 @@ type GargPrivateAPI' =
 ---------------------------------------------------------------------
 
 type API = SwaggerAPI
-       :<|> FrontEndAPI
-       :<|> Get '[HTML] Html
        :<|> GargAPI
+       :<|> FrontEndAPI
 
 -- This is the concrete monad. It needs to be used as little as possible,
 -- instead, prefer GargServer, GargServerT, GargServerC.
@@ -343,9 +338,8 @@ server :: forall env. EnvC env => env -> IO (Server API)
 server env = do
   -- orchestrator <- scrapyOrchestrator env
   pure $  schemaUiServer swaggerDoc
-     :<|> frontEndServer
-     :<|> serverStatic
      :<|> hoistServerWithContext (Proxy :: Proxy GargAPI) (Proxy :: Proxy AuthContext) transform serverGargAPI
+     :<|> frontEndServer
   where
     transform :: forall a. GargServerM env GargError a -> Handler a
     transform = Handler . withExceptT showAsServantErr . (`runReaderT` env)
@@ -426,13 +420,14 @@ addAnnuaireWithForm cid =
   serveJobsAPI $
     JobFunction (\i log -> Annuaire.addToAnnuaireWithForm cid i (liftIO . log))
 
+{-
 serverStatic :: Server (Get '[HTML] Html)
 serverStatic = $(do
                   let path = "purescript-gargantext/dist/index.html"
                   Just s <- liftIO (fileTypeToFileTree (FileTypeFile path))
                   fileTreeToServer s
                 )
-
+-}
 ---------------------------------------------------------------------
 --gargMock :: Server GargAPI
 --gargMock = mock apiGarg Proxy

src/Gargantext/API/FrontEnd.hs

@@ -12,15 +12,16 @@ Loads all static file for the front-end.
 -}
 
 {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE TypeOperators        #-}
 
 ---------------------------------------------------------------------
 module Gargantext.API.FrontEnd where
 
-import Servant.Static.TH (createApiAndServerDecs)
+import Servant
+import Servant.Server.StaticFiles (serveDirectoryFileServer)
 
----------------------------------------------------------------------
-$(createApiAndServerDecs "FrontEndAPI" "frontEndServer" "purescript-gargantext/dist")
----------------------------------------------------------------------
+type FrontEndAPI = Raw
 
+frontEndServer :: Server FrontEndAPI
+frontEndServer = serveDirectoryFileServer "./purescript-gargantext/dist"

src/Gargantext/Database/Schema/Node.hs

@@ -526,7 +526,7 @@ nodePhyloW maybeName maybePhylo pId = node NodePhylo name graph (Just pId)
 
 ------------------------------------------------------------------------
 arbitraryDashboard :: HyperdataDashboard
-arbitraryDashboard = HyperdataDashboard (Just "Preferences")
+arbitraryDashboard = HyperdataDashboard (Just "Preferences") []
 ------------------------------------------------------------------------
 
 node :: (ToJSON a, Hyperdata a) => NodeType -> Name -> a -> Maybe ParentId -> UserId -> NodeWrite
@@ -611,6 +611,11 @@ postNode uid pid (Node' NodeAnnuaire txt v ns) = do
   pids  <- mkNodeR (concat $ map (\n -> [childWith uid pid' n]) ns)
   pure $ NewNode pid' pids
 
+postNode uid pid (Node' NodeDashboard txt v ns) = do
+  NewNode pid' _ <- postNode uid pid (Node' NodeDashboard txt v [])
+  pids  <- mkNodeR (concat $ map (\n -> [childWith uid pid' n]) ns)
+  pure $ NewNode pid' pids
+
 postNode _ _ (Node' _ _ _ _) = nodeError NotImplYet
 
 

src/Gargantext/Database/Types/Node.hs

@@ -325,7 +325,6 @@ data CorpusField = MarkdownField { _cf_text :: !Text }
                               , _cf_desc  :: !Text
                               , _cf_query :: !Text
                               , _cf_authors :: !Text
-                              , _cf_charts :: ![Chart]
                               -- , _cf_resources :: ![Resource]
                               } 
                   | HaskellField { _cf_haskell :: !Text }
@@ -375,7 +374,7 @@ corpusExample = "" -- TODO
 
 defaultCorpus :: HyperdataCorpus
 defaultCorpus = HyperdataCorpus [
-    HyperdataField JSON "Mandatory fields" (JsonField "Title" "Descr" "Bool query" "Authors" [])
+    HyperdataField JSON "Mandatory fields" (JsonField "Title" "Descr" "Bool query" "Authors")
   , HyperdataField Markdown "Optional Text" (MarkdownField "# title\n## subtitle")
   ]
 
@@ -454,6 +453,7 @@ instance Hyperdata HyperdataResource
 
 ------------------------------------------------------------------------
 data HyperdataDashboard = HyperdataDashboard { hyperdataDashboard_preferences   :: !(Maybe Text)
+                                             , hyperdataDashboard_charts        :: ![Chart]
                                    } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard)
 

stack.yaml

-resolver: lts-14.22
+resolver: lts-14.27
 flags: {}
 extra-package-dbs: []
 packages:
@@ -74,6 +74,7 @@ extra-deps:
 - serialise-0.2.0.0
 - servant-flatten-0.2
   #- servant-multipart-0.11.2
+- servant-server-0.16
 - stemmer-0.5.2
 - time-units-1.0.0
 - validity-0.9.0.0 # patches-{map,class}