Commit 1f772ccb authored by David Davó's avatar David Davó

Added jslink and removed warnings

parent 6275019a
...@@ -140,7 +140,7 @@ library ...@@ -140,7 +140,7 @@ library
-- The singletons package version is locked to the compiler -- The singletons package version is locked to the compiler
-- so let cabal choose the right one. -- so let cabal choose the right one.
, singletons >= 2.6 , singletons -any
if impl (ghc >= 9.0) if impl (ghc >= 9.0)
build-depends: singletons-base -any build-depends: singletons-base -any
......
...@@ -68,4 +68,4 @@ import IHaskell.Display.Widgets.Common as X ...@@ -68,4 +68,4 @@ import IHaskell.Display.Widgets.Common as X
import IHaskell.Display.Widgets.Types as X (setField, getField, properties, triggerDisplay, import IHaskell.Display.Widgets.Types as X (setField, getField, properties, triggerDisplay,
triggerChange, triggerClick, triggerSelection, triggerChange, triggerClick, triggerSelection,
triggerSubmit, ChildWidget(..), StyleWidget(..), triggerSubmit, ChildWidget(..), StyleWidget(..),
WidgetFieldPair(..), Date(..)) WidgetFieldPair(..), Date(..), unlink)
...@@ -27,7 +27,6 @@ import IHaskell.Display.Widgets.Types ...@@ -27,7 +27,6 @@ import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common import IHaskell.Display.Widgets.Common
import IHaskell.Display.Widgets.Style.ButtonStyle import IHaskell.Display.Widgets.Style.ButtonStyle
import IHaskell.Display.Widgets.Layout.LayoutWidget import IHaskell.Display.Widgets.Layout.LayoutWidget
import IHaskell.Display.Widgets.Style.DescriptionStyle
-- | A 'Button' represents a Button from IPython.html.widgets. -- | A 'Button' represents a Button from IPython.html.widgets.
type Button = IPythonWidget 'ButtonType type Button = IPythonWidget 'ButtonType
......
...@@ -20,17 +20,13 @@ import Control.Monad (void) ...@@ -20,17 +20,13 @@ import Control.Monad (void)
import Data.Aeson import Data.Aeson
import Data.Aeson.Types (parse) import Data.Aeson.Types (parse)
import Data.Text (Text)
import Data.IORef (newIORef) import Data.IORef (newIORef)
import Data.Maybe (fromJust,isJust)
import qualified Data.Scientific as Sci
import Data.Vinyl (Rec(..), (<+>)) import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display import IHaskell.Display
import IHaskell.Eval.Widgets import IHaskell.Eval.Widgets
import IHaskell.IPython.Message.UUID as U import IHaskell.IPython.Message.UUID as U
import IHaskell.Display.Widgets.Singletons (Field, SField)
import IHaskell.Display.Widgets.Types import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common import IHaskell.Display.Widgets.Common
import IHaskell.Display.Widgets.Layout.LayoutWidget import IHaskell.Display.Widgets.Layout.LayoutWidget
......
...@@ -15,10 +15,8 @@ module IHaskell.Display.Widgets.Controller.ControllerAxis ...@@ -15,10 +15,8 @@ module IHaskell.Display.Widgets.Controller.ControllerAxis
-- To keep `cabal repl` happy when running from the ihaskell repo -- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude import Prelude
import Control.Monad (void)
import Data.Aeson import Data.Aeson
import Data.IORef (newIORef) import Data.IORef (newIORef)
import qualified Data.Scientific as Sci
import Data.Vinyl (Rec(..), (<+>)) import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display import IHaskell.Display
......
...@@ -15,10 +15,8 @@ module IHaskell.Display.Widgets.Controller.ControllerButton ...@@ -15,10 +15,8 @@ module IHaskell.Display.Widgets.Controller.ControllerButton
-- To keep `cabal repl` happy when running from the ihaskell repo -- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude import Prelude
import Control.Monad (void)
import Data.Aeson import Data.Aeson
import Data.IORef (newIORef) import Data.IORef (newIORef)
import qualified Data.Scientific as Sci
import Data.Vinyl (Rec(..), (<+>)) import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display import IHaskell.Display
......
...@@ -13,15 +13,6 @@ ...@@ -13,15 +13,6 @@
module IHaskell.Display.Widgets.Layout.Common where module IHaskell.Display.Widgets.Layout.Common where
import Data.Aeson
import Data.Aeson.Types (emptyObject)
import Data.HashMap.Strict as HM
import Data.Text (pack, Text)
import Data.Typeable (Typeable)
import IHaskell.Display (IHaskellWidget)
import IHaskell.Eval.Widgets (widgetSendClose)
import qualified IHaskell.Display.Widgets.Singletons as S import qualified IHaskell.Display.Widgets.Singletons as S
pattern AlignContent = S.SLAlignContent pattern AlignContent = S.SLAlignContent
......
...@@ -15,11 +15,8 @@ module IHaskell.Display.Widgets.Layout.LayoutWidget ...@@ -15,11 +15,8 @@ module IHaskell.Display.Widgets.Layout.LayoutWidget
-- To keep `cabal repl` happy when running from the ihaskell repo -- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude import Prelude
import Control.Monad (void)
import Data.Aeson import Data.Aeson
import Data.IORef (newIORef) import Data.IORef (newIORef)
import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display import IHaskell.Display
import IHaskell.Eval.Widgets import IHaskell.Eval.Widgets
...@@ -27,7 +24,6 @@ import IHaskell.IPython.Message.UUID as U ...@@ -27,7 +24,6 @@ import IHaskell.IPython.Message.UUID as U
import IHaskell.Display.Widgets.Types import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Layout.Types import IHaskell.Display.Widgets.Layout.Types
import IHaskell.Display.Widgets.Layout.Common
-- | A 'Layout' represents a Layout from IPython.html.widgets. -- | A 'Layout' represents a Layout from IPython.html.widgets.
type Layout = IPythonWidget 'LayoutType type Layout = IPythonWidget 'LayoutType
......
...@@ -24,31 +24,9 @@ import Prelude hiding (Right,Left) ...@@ -24,31 +24,9 @@ import Prelude hiding (Right,Left)
import Control.Monad (unless) import Control.Monad (unless)
import qualified Control.Exception as Ex import qualified Control.Exception as Ex
import Data.Aeson hiding (pairs)
import Data.List (intercalate) import Data.List (intercalate)
import Data.Typeable (Typeable, TypeRep, typeOf)
#if MIN_VERSION_vinyl(0,9,0) import Data.Vinyl (Rec(..))
import Data.Vinyl (Rec(..), Dict(..))
import Data.Vinyl.Recursive ((<+>), recordToList, reifyConstraint, rmap)
#else
import Data.Vinyl (Rec(..), (<+>), recordToList, reifyConstraint, rmap, Dict(..))
#endif
import Data.Vinyl.Lens (rget, rput, type ())
#if MIN_VERSION_singletons(3,0,0)
import Data.List.Singletons
#elif MIN_VERSION_singletons(2,4,0)
import Data.Singletons.Prelude.List
#else
import Data.Singletons.Prelude ((:++))
#endif
#if MIN_VERSION_singletons(3,0,0)
import Data.Singletons.Base.TH
#else
import Data.Singletons.TH
#endif
import qualified IHaskell.Display.Widgets.Singletons as S import qualified IHaskell.Display.Widgets.Singletons as S
import IHaskell.Display.Widgets.Types import IHaskell.Display.Widgets.Types
......
...@@ -10,6 +10,8 @@ module IHaskell.Display.Widgets.Link.DirectionalLink ...@@ -10,6 +10,8 @@ module IHaskell.Display.Widgets.Link.DirectionalLink
DirectionalLink DirectionalLink
-- * Constructor -- * Constructor
, mkDirectionalLink , mkDirectionalLink
-- * Another constructor
, jsdlink
) where ) where
-- To keep `cabal repl` happy when running from the ihaskell repo -- To keep `cabal repl` happy when running from the ihaskell repo
...@@ -17,8 +19,6 @@ import Prelude ...@@ -17,8 +19,6 @@ import Prelude
import Data.Aeson import Data.Aeson
import Data.IORef (newIORef) import Data.IORef (newIORef)
import Data.Monoid (mempty)
import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display import IHaskell.Display
import IHaskell.Eval.Widgets import IHaskell.Eval.Widgets
...@@ -26,7 +26,6 @@ import IHaskell.IPython.Message.UUID as U ...@@ -26,7 +26,6 @@ import IHaskell.IPython.Message.UUID as U
import IHaskell.Display.Widgets.Types import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common import IHaskell.Display.Widgets.Common
import IHaskell.Display.Widgets.Layout.LayoutWidget
-- | An 'DirectionalLink' represents a DirectionalLink widget from IPython.html.widgets. -- | An 'DirectionalLink' represents a DirectionalLink widget from IPython.html.widgets.
type DirectionalLink = IPythonWidget 'DirectionalLinkType type DirectionalLink = IPythonWidget 'DirectionalLinkType
...@@ -49,5 +48,13 @@ mkDirectionalLink = do ...@@ -49,5 +48,13 @@ mkDirectionalLink = do
-- Return the DirectionalLink widget -- Return the DirectionalLink widget
return widget return widget
-- | An easier constructor that links two widgets
jsdlink :: WidgetFieldPair -> WidgetFieldPair -> IO DirectionalLink
jsdlink wfp1 wfp2 = do
dlink <- mkDirectionalLink
_ <- setField dlink Source wfp1
_ <- setField dlink Target wfp2
return dlink
instance IHaskellWidget DirectionalLink where instance IHaskellWidget DirectionalLink where
getCommUUID = uuid getCommUUID = uuid
...@@ -10,6 +10,8 @@ module IHaskell.Display.Widgets.Link.Link ...@@ -10,6 +10,8 @@ module IHaskell.Display.Widgets.Link.Link
Link Link
-- * Constructor -- * Constructor
, mkLink , mkLink
-- * Easier constructor
, jslink
) where ) where
-- To keep `cabal repl` happy when running from the ihaskell repo -- To keep `cabal repl` happy when running from the ihaskell repo
...@@ -17,8 +19,6 @@ import Prelude ...@@ -17,8 +19,6 @@ import Prelude
import Data.Aeson import Data.Aeson
import Data.IORef (newIORef) import Data.IORef (newIORef)
import Data.Monoid (mempty)
import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display import IHaskell.Display
import IHaskell.Eval.Widgets import IHaskell.Eval.Widgets
...@@ -26,7 +26,6 @@ import IHaskell.IPython.Message.UUID as U ...@@ -26,7 +26,6 @@ import IHaskell.IPython.Message.UUID as U
import IHaskell.Display.Widgets.Types import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common import IHaskell.Display.Widgets.Common
import IHaskell.Display.Widgets.Layout.LayoutWidget
-- | An 'Link' represents a Link widget from IPython.html.widgets. -- | An 'Link' represents a Link widget from IPython.html.widgets.
type Link = IPythonWidget 'LinkType type Link = IPythonWidget 'LinkType
...@@ -49,5 +48,13 @@ mkLink = do ...@@ -49,5 +48,13 @@ mkLink = do
-- Return the link widget -- Return the link widget
return widget return widget
-- | An easier constructor that links two widgets
jslink :: WidgetFieldPair -> WidgetFieldPair -> IO Link
jslink wfp1 wfp2 = do
link <- mkLink
_ <- setField link Source wfp1
_ <- setField link Target wfp2
return link
instance IHaskellWidget Link where instance IHaskellWidget Link where
getCommUUID = uuid getCommUUID = uuid
...@@ -17,7 +17,6 @@ import Prelude ...@@ -17,7 +17,6 @@ import Prelude
import Data.Aeson import Data.Aeson
import Data.IORef (newIORef) import Data.IORef (newIORef)
import Data.Monoid (mempty)
import Data.Vinyl (Rec(..), (<+>)) import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display import IHaskell.Display
......
...@@ -17,7 +17,6 @@ import Prelude ...@@ -17,7 +17,6 @@ import Prelude
import Data.Aeson import Data.Aeson
import Data.IORef (newIORef) import Data.IORef (newIORef)
import Data.Monoid (mempty)
import Data.Vinyl (Rec(..), (<+>)) import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display import IHaskell.Display
...@@ -40,9 +39,9 @@ mkImageWidget = do ...@@ -40,9 +39,9 @@ mkImageWidget = do
let mediaAttrs = defaultMediaWidget "ImageView" "ImageModel" layout let mediaAttrs = defaultMediaWidget "ImageView" "ImageModel" layout
imageAttrs = (ImageFormat =:: PNG) imageAttrs = (ImageFormat =:: PNG)
:& (Width =:+ 0) :& (Width =:+ 0)
:& (Height =:+ 0) :& (Height =:+ 0)
:& RNil :& RNil
widgetState = WidgetState (mediaAttrs <+> imageAttrs) widgetState = WidgetState (mediaAttrs <+> imageAttrs)
stateIO <- newIORef widgetState stateIO <- newIORef widgetState
......
...@@ -17,7 +17,6 @@ import Prelude ...@@ -17,7 +17,6 @@ import Prelude
import Data.Aeson import Data.Aeson
import Data.IORef (newIORef) import Data.IORef (newIORef)
import Data.Monoid (mempty)
import Data.Vinyl (Rec(..), (<+>)) import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display import IHaskell.Display
......
...@@ -19,7 +19,6 @@ import Control.Monad (void) ...@@ -19,7 +19,6 @@ import Control.Monad (void)
import Data.Aeson import Data.Aeson
import Data.IORef (newIORef) import Data.IORef (newIORef)
import qualified Data.Scientific as Sci import qualified Data.Scientific as Sci
import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display import IHaskell.Display
import IHaskell.Eval.Widgets import IHaskell.Eval.Widgets
......
...@@ -16,9 +16,9 @@ ...@@ -16,9 +16,9 @@
{-# LANGUAGE StandaloneKindSignatures #-} {-# LANGUAGE StandaloneKindSignatures #-}
#endif #endif
module IHaskell.Display.Widgets.Singletons where {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
import Data.Kind module IHaskell.Display.Widgets.Singletons where
#if MIN_VERSION_singletons(3,0,0) #if MIN_VERSION_singletons(3,0,0)
import Data.Singletons.Base.TH import Data.Singletons.Base.TH
......
...@@ -18,7 +18,6 @@ import Prelude ...@@ -18,7 +18,6 @@ import Prelude
import Control.Monad (when) import Control.Monad (when)
import Data.Aeson import Data.Aeson
import Data.IORef (newIORef) import Data.IORef (newIORef)
import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display import IHaskell.Display
import IHaskell.Eval.Widgets import IHaskell.Eval.Widgets
......
...@@ -18,7 +18,6 @@ import Prelude ...@@ -18,7 +18,6 @@ import Prelude
import Control.Monad (when) import Control.Monad (when)
import Data.Aeson import Data.Aeson
import Data.IORef (newIORef) import Data.IORef (newIORef)
import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display import IHaskell.Display
import IHaskell.Eval.Widgets import IHaskell.Eval.Widgets
...@@ -54,7 +53,7 @@ mkTextWidget = do ...@@ -54,7 +53,7 @@ mkTextWidget = do
instance IHaskellWidget TextWidget where instance IHaskellWidget TextWidget where
getCommUUID = uuid getCommUUID = uuid
-- Two possibilities: 1. content -> event -> "submit" 2. sync_data -> value -> <new_value> -- Two possibilities: 1. content -> event -> "submit" 2. state -> value -> <new_value>
comm tw val _ = do comm tw val _ = do
case nestedObjectLookup val ["state", "value"] of case nestedObjectLookup val ["state", "value"] of
Just (String value) -> setField' tw StringValue value >> triggerChange tw Just (String value) -> setField' tw StringValue value >> triggerChange tw
......
...@@ -17,14 +17,12 @@ import Prelude ...@@ -17,14 +17,12 @@ import Prelude
import Data.Aeson import Data.Aeson
import Data.IORef (newIORef) import Data.IORef (newIORef)
import Data.Vinyl (Rec(..), (<+>))
import IHaskell.Display import IHaskell.Display
import IHaskell.Eval.Widgets import IHaskell.Eval.Widgets
import IHaskell.IPython.Message.UUID as U import IHaskell.IPython.Message.UUID as U
import IHaskell.Display.Widgets.Types import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | A 'DescriptionStyle' represents a Button Style from IPython.html.widgets. -- | A 'DescriptionStyle' represents a Button Style from IPython.html.widgets.
type DescriptionStyle = IPythonWidget 'DescriptionStyleType type DescriptionStyle = IPythonWidget 'DescriptionStyleType
......
...@@ -108,7 +108,7 @@ import Data.Text.Lazy.Encoding ...@@ -108,7 +108,7 @@ import Data.Text.Lazy.Encoding
import GHC.IO.Exception import GHC.IO.Exception
import IHaskell.Eval.Widgets (widgetSendUpdate, widgetSendView) import IHaskell.Eval.Widgets (widgetSendUpdate, widgetSendView)
import IHaskell.Display (Base64, IHaskellWidget(..), IHaskellDisplay(..), Display(..), widgetdisplay, base64) import IHaskell.Display (IHaskellWidget(..), IHaskellDisplay(..), Display(..), widgetdisplay, base64)
import IHaskell.IPython.Message.UUID import IHaskell.IPython.Message.UUID
import IHaskell.Display.Widgets.Singletons (Field, SField, toKey, HasKey) import IHaskell.Display.Widgets.Singletons (Field, SField, toKey, HasKey)
...@@ -965,4 +965,13 @@ instance FromJSON Date where ...@@ -965,4 +965,13 @@ instance FromJSON Date where
<*> ((+1) <$> v .: "month") <*> ((+1) <$> v .: "month")
<*> v .: "date" <*> v .: "date"
parseJSON Null = pure NullDate parseJSON Null = pure NullDate
parseJSON _ = mzero parseJSON _ = mzero
\ No newline at end of file
-- | Allows you to unlink a jslink
unlink :: ('S.Source WidgetFields w, 'S.Target WidgetFields w, IHaskellWidget (IPythonWidget w))
=> IPythonWidget w
-> IO (IPythonWidget w)
unlink w = do
_ <- setField' w Source EmptyWT
_ <- setField' w Target EmptyWT
return w
\ No newline at end of file
{-# language NoImplicitPrelude, DoAndIfThenElse, OverloadedStrings, ExtendedDefaultRules #-} {-# language NoImplicitPrelude, DoAndIfThenElse, OverloadedStrings, ExtendedDefaultRules, CPP #-}
module IHaskell.Eval.Widgets ( module IHaskell.Eval.Widgets (
widgetSendOpen, widgetSendOpen,
widgetSendView, widgetSendView,
...@@ -18,13 +18,11 @@ import Control.Concurrent.STM (atomically) ...@@ -18,13 +18,11 @@ import Control.Concurrent.STM (atomically)
import Control.Concurrent.STM.TChan import Control.Concurrent.STM.TChan
import Control.Monad (foldM) import Control.Monad (foldM)
import Data.Aeson import Data.Aeson
import Data.Aeson.Types (emptyArray)
import Data.ByteString.Lazy (toStrict)
import Data.ByteString.Base64 as B64 (decodeLenient) import Data.ByteString.Base64 as B64 (decodeLenient)
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Text.Encoding (encodeUtf8) import Data.Text.Encoding (encodeUtf8)
import Data.HashMap.Strict as HM (lookup,insert,delete) import Data.HashMap.Strict as HM (lookup,insert,delete)
import Data.Functor ((<&>))
import Data.Foldable (foldl) import Data.Foldable (foldl)
import System.IO.Unsafe (unsafePerformIO) import System.IO.Unsafe (unsafePerformIO)
...@@ -33,6 +31,14 @@ import IHaskell.Eval.Util (unfoldM) ...@@ -33,6 +31,14 @@ import IHaskell.Eval.Util (unfoldM)
import IHaskell.IPython.Types (showMessageType) import IHaskell.IPython.Types (showMessageType)
import IHaskell.Types import IHaskell.Types
#if MIN_VERSION_base(4,11,0)
import Data.Functor ((<&>))
#else
(<&>) :: Functor f => f a -> (a -> b) -> f b
a <&> f = fmap f a
infixl 1 <&>
#endif
-- All comm_open messages go here -- All comm_open messages go here
widgetMessages :: TChan WidgetMsg widgetMessages :: TChan WidgetMsg
{-# NOINLINE widgetMessages #-} {-# NOINLINE widgetMessages #-}
......
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