Commit de7f549b authored by arturo's avatar arturo

>>> continue

parent d2dd2402
module Gargantext.Components.Forest.Tree.Node.Action.Add where
import Gargantext.Prelude
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Data.Array (head, length)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff_)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe', panel, submitButton)
......@@ -18,9 +22,6 @@ import Gargantext.Types (NodeType(..), charCodeIcon)
import Gargantext.Types as GT
import Gargantext.Utils (nbsp)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Add"
......
module Gargantext.Components.Forest.Tree.Node.Tools where
import Gargantext.Prelude
( class Ord, class Read, class Show, Unit
, bind, const, discard, map, not, pure, read, show, when, mempty
, ($), (<), (<<<), (<>), (<$>), (<*>) )
import Data.Maybe (fromMaybe, Maybe(..))
import Data.Nullable (null)
import Data.Set (Set)
......@@ -8,18 +12,18 @@ import Data.String as S
import Data.String.CodeUnits as DSCU
import Effect (Effect)
import Effect.Aff (Aff, launchAff, launchAff_)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Components.Forest.Tree.Node.Action (Action, icon, text)
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Ends (Frontends, url)
import Gargantext.Prelude (class Ord, class Read, class Show, Unit, bind, const, discard, map, mempty, not, pure, read, show, when, ($), (<), (<<<), (<>), (<$>), (<*>))
import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types as GT
import Gargantext.Utils (glyphicon, toggleSet)
import Gargantext.Utils.ReactTooltip as ReactTooltip
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools"
......
module Gargantext.Types where
import Gargantext.Prelude
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Argonaut.Decode.Error (JsonDecodeError(..))
import Data.Array as A
......@@ -22,6 +20,8 @@ import Prim.Row (class Union)
import Reactix as R
import URI.Query (Query)
import Gargantext.Prelude
data Handed = LeftHanded | RightHanded
switchHanded :: forall a. a -> a -> Handed -> a
......@@ -248,7 +248,7 @@ instance readNodeType :: Read NodeType where
-- (?) UI print Glyphicon directly on text node
--
-- * convert "Glyphicon ForkAwesome" classNames to CharCode [1]
-- * bypass React "dangerousInnerHTML" via vanilla JavaScript coerce [2]
-- * bypass React "dangerousInnerHTML" via vanilla JavaScript coerce [2]
-- (see "forkawesome.css" dist file for conversion matching)
--
-- [1] https://stackoverflow.com/a/54002856/6003907
......
module Gargantext.Utils where
import Prelude
import Data.Char (fromCharCode)
import Data.Either (Either(..))
import Data.Foldable (class Foldable, foldr)
......@@ -15,6 +13,7 @@ import Data.String as S
import Data.String.CodeUnits (singleton)
import Data.Unfoldable (class Unfoldable)
import Effect (Effect)
import Prelude
import Partial.Unsafe (unsafePartial)
import Web.HTML as WHTML
import Web.HTML.Location as WHL
......
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