Commit 5520bb2d authored by Ali El Amrani's avatar Ali El Amrani

Add types and ressources to dev

parent 348b0164
module Phylo.Ressources where
import Data.Date
import Graphics.D3.Base
import Graphics.D3.Request
import Graphics.D3.Util
import Prelude
import Effect (Effect)
import Graphics.D3.Contour as Contour
import Graphics.D3.Link as Link
import Graphics.D3.SVG.Axis as Axis
import Graphics.D3.Scale as Scale
import Graphics.D3.Selection ((>=>), (>=>-), (>=>++))
import Graphics.D3.Selection as Selection
import Graphics.D3.Time as Time
import Graphics.D3.Zoom as Zoom
import Phylo.Types as PT
-- Date functions
-- Timeline
-- Isoline
drawIsoline :: Effect Unit
drawIsoline = do
isoline <- Selection.rootSelect "#isoline"
let div = -- Here get node() value and getBoundingClientRect()
-- PhyloPhylo
-- Hello
\ No newline at end of file
module Phylo.Types where
import Prelude
import Affjax as AX
import Affjax.ResponseFormat as ResponseFormat
import DOM.Simple.Console (log, log2)
import Data.Generic.Rep (class Generic)
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Simple.JSON as JSON
newtype PhyloJSON = PhyloJSON
{ name :: String
, phyloDocs :: String
, phyloFoundations :: String
, phyloPeriods :: String
, phyloTerms :: String
, phyloGroups :: String
, phyloBranches :: String
, objects :: Array PhyloObject
, edges :: Array PhyloEdge
}
data NodeType = NodeBranch | NodeGroup | NodePeriod
derive instance Eq NodeType
instance Show NodeType where
show NodeBranch = "branch"
show NodeGroup = "group"
show NodePeriod = "period"
data PhyloObject = Branch
{ _gvid :: Int
, bId :: String
, nodeType :: NodeType
}| Group
{ _gvid :: Int
, bId :: String
, nodeType :: NodeType
}| Period
{ _gvid :: Int
, nodeType :: NodeType
}| Default
{
_gvid :: Int
}
-- instance JSON.ReadForeign PhyloObject where
-- readImpl f = do
-- s <- JSON.readImpl f
-- case s.nodeType of
-- "branch" -> pure Branch
-- "group" -> pure Group
-- "period" -> pure Period
-- x -> pure Default
data EdgeType = LinkType | BranchLinkType | AncestorLinkType
derive instance Eq EdgeType
instance Show EdgeType where
show LinkType = "link"
show BranchLinkType = "ancestorLink"
show AncestorLinkType = "branchLink"
data PhyloEdge = Link
{ _gvid :: Int
, bId :: String
, edgeType :: EdgeType
}| AncestorLink
{ _gvid :: Int
, bId :: String
, edgeType :: EdgeType
}| BranchLink
{ _gvid :: Int
, bId :: String
, edgeType :: EdgeType
}| DefaultLink
{
_gvid :: Int
}
-- type PhyloObjects =
-- { _gvid :: Int
-- , shape :: Maybe String
-- , nodeType :: Maybe String
-- }
--
-- type PhyloEdges =
-- { _gvid :: Int
-- , color :: Maybe String
-- , edgeType :: Maybe String
-- }
-- data PhyloObjects = Branch
-- { _gvid :: Int
-- , name :: String
-- , nodeType :: Maybe String
-- } | Group
-- { _gvid :: Int
-- , name :: String
-- , nodeType :: Maybe String
-- } | Period
-- { _gvid :: Int
-- , name :: String
-- , nodeType :: Maybe String
-- }
--
-- data PhyloEdges = Link
-- { _gvid :: Int
-- , head :: Int
-- , edgeType :: Maybe String
-- } | BranchLink
-- { _gvid :: Int
-- , head :: Int
-- , edgeType :: Maybe String
-- } | AncestorLink
-- { _gvid :: Int
-- , head :: Int
-- , edgeType :: Maybe String
-- }
--
-- instance JSON.ReadForeign PhyloEdges where
-- readImpl f = do
-- inst <- JSON.readImpl f
-- pure $ PhyloEdges
fetchPhyloJSON :: Aff (Maybe PhyloJSON)
fetchPhyloJSON = do
result <- AX.request (AX.defaultRequest { url = "http://localhost:5501/data/knowledge-phylomemy.json", method = Left GET, responseFormat = ResponseFormat.string })
case result of
Left err -> do
liftEffect $ log $ "Phylo failed to load error : " <> AX.printError err
pure Nothing
Right response -> liftEffect $ do
case JSON.readJSON response.body of
Left err -> do
log $ "Fail with error: " <> show err
pure Nothing
Right (r :: PhyloJSON) -> do
log $ "name of phylo is : " <> show r.name
pure $ Just r
logPhyloJSON :: Effect Unit
logPhyloJSON = do
launchAff_ $ do
mr <- fetchPhyloJSON
liftEffect $ do
case mr of
Nothing -> log "Nothing"
Just r -> log2 "r" r
-- getName :: PhyloJSON -> String
-- getName phylo = phylo.name
-- getObjects :: PhyloJSON -> Array PhyloObjects
-- getObjects
--
\ No newline at end of file
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment