Compare commits

..

6 Commits

Author SHA1 Message Date
Ryan Trinkle
aea4f3b654 Cleanups 2023-07-04 13:01:18 -04:00
Ryan Trinkle
e4b862f1b5 Use FromJSVal for props 2023-07-04 13:01:15 -04:00
Ryan Trinkle
191ae58b73 Remove unused file 2023-07-04 13:00:45 -04:00
Ryan Trinkle
24d7343fb9 Clean up LANGUAGE pragmas 2023-07-04 13:00:42 -04:00
Ryan Trinkle
141b482739 Get rid of Render monad; make components look more like JS components 2023-07-04 12:50:17 -04:00
Ryan Trinkle
aa5d40a625 Delete unsupported hooks 2023-07-04 12:49:48 -04:00
8 changed files with 13 additions and 131 deletions

View File

@ -1,58 +0,0 @@
{-# LANGUAGE RecordWildCards #-}
import Distribution.PackageDescription.Parsec
import Distribution.PackageDescription
import Distribution.Types.Library
import Distribution.Types.ModuleReexport
import Distribution.Verbosity
import Distribution.ModuleName (components)
import System.Environment (getArgs)
import System.Directory (createDirectoryIfMissing)
import System.FilePath ((</>), (<.>), joinPath, takeDirectory)
import Data.List.Split (splitOn)
import Data.List (intercalate)
-- Helper function to convert a module name to a file path
convertModuleToPath :: String -> FilePath
convertModuleToPath moduleName = "src" </> joinPath (splitOn "." moduleName) <.> "hs"
-- Function to write a file with the given module structure
writeModuleFile :: (String, String) -> IO ()
writeModuleFile (originalModule, newModule) = do
let content = unlines
[ "module " ++ newModule ++ " (module X) where"
, ""
, "import " ++ originalModule ++ " as X"
]
filePath = convertModuleToPath newModule
createDirectoryIfMissing True (takeDirectory filePath)
writeFile filePath content
main :: IO ()
main = do
args <- getArgs
case args of
[fileName] -> do
result <- parseCabalFile fileName
case result of
Left err -> putStrLn $ "Error: " ++ err
Right reexports -> mapM_ writeModuleFile reexports
_ -> putStrLn "Usage: cabal-file-parser <filename.cabal>"
parseCabalFile :: FilePath -> IO (Either String [(String, String)])
parseCabalFile filePath = do
result <- readGenericPackageDescription silent filePath
let maybeMainLib = case condLibrary result of
Just (CondNode lib _ _) -> Just lib
Nothing -> Nothing
subLibs = [lib | (_, CondNode lib _ _) <- condSubLibraries result]
libs = maybe subLibs (:subLibs) maybeMainLib
return $ case libs of
(lib:_) -> Right (extractReexportedModules lib)
[] -> Left "No library found in .cabal file."
extractReexportedModules :: Library -> [(String, String)]
extractReexportedModules lib =
map (\ModuleReexport{..} -> (moduleNameString moduleReexportOriginalName, moduleNameString moduleReexportName)) (reexportedModules lib)
moduleNameString = intercalate "." . components

View File

@ -44,3 +44,8 @@ library
build-depends: jsaddle-warp build-depends: jsaddle-warp
default-language: Haskell2010 default-language: Haskell2010
default-extensions:
FlexibleInstances
GeneralizedNewtypeDeriving
LambdaCase
OverloadedStrings

View File

@ -1,4 +1,3 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module React.Component where module React.Component where
import Control.Monad.Except import Control.Monad.Except
@ -9,15 +8,17 @@ import React.JSaddle
import React.Types import React.Types
--TODO: The Hook section shouldn't have any control flow to it; probably it also shouldn't depend on props except in specific ways --TODO: The Hook section shouldn't have any control flow to it; probably it also shouldn't depend on props except in specific ways
component :: Hook (JSVal -> Render Element) -> ReaderT React JSM (Component JSVal ()) component :: FromJSVal props => (props -> Hook Element) -> ReaderT React JSM (Component props ())
component (Hook hook) = do component hook = do
react <- ask react <- ask
f <- lift $ function' $ \_ _ args -> flip runReaderT react $ do f <- lift $ function' $ \_ _ args -> flip runReaderT react $ do
render <- hook let propsVal = case args of
let props = case args of
[] -> jsUndefined [] -> jsUndefined
arg0 : _ -> arg0 arg0 : _ -> arg0
e <- unRender $ render props props <- liftJSM $ fromJSVal propsVal >>= \case
Nothing -> fail "Invalid props"
Just props -> pure props
e <- unHook $ hook props
unElement e unElement e
pure $ Component f pure $ Component f

View File

@ -1,4 +1,3 @@
{-# LANGUAGE OverloadedStrings #-}
module React.Element where module React.Element where
import Control.Monad.Except import Control.Monad.Except

View File

@ -1,5 +1,4 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module React.Export where module React.Export where

View File

@ -1,5 +1,3 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module React.Hook where module React.Hook where
import Prelude hiding ((!!)) import Prelude hiding ((!!))
@ -7,7 +5,6 @@ import Prelude hiding ((!!))
import Control.Monad import Control.Monad
import Control.Monad.Except import Control.Monad.Except
import Control.Monad.Reader import Control.Monad.Reader
import Data.Text (Text)
import Language.Javascript.JSaddle hiding (Ref) import Language.Javascript.JSaddle hiding (Ref)
import React.JSaddle import React.JSaddle
@ -16,6 +13,7 @@ import React.Types
--TODO: Input can be an initializer function rather than value --TODO: Input can be an initializer function rather than value
--TODO: `set` can take `a -> a` instead of `a` --TODO: `set` can take `a -> a` instead of `a`
--TODO: I bet React always returns the same function object for the setter; if we re-wrap the function using `useCallback` each time, we are probably hurting performance by making it be a new object each time and forcing rerendering of children
useState :: (ToJSVal a, FromJSVal a) => a -> Hook (a, a -> JSM ()) useState :: (ToJSVal a, FromJSVal a) => a -> Hook (a, a -> JSM ())
useState initialValue = Hook $ do useState initialValue = Hook $ do
react <- ask react <- ask
@ -68,51 +66,3 @@ useCallback f deps = Hook $ do
depsArray <- lift $ toJSVal =<< sequence someDeps depsArray <- lift $ toJSVal =<< sequence someDeps
pure [depsArray] pure [depsArray]
lift $ (react # t "useCallback") $ [pToJSVal cb] <> depsArg lift $ (react # t "useCallback") $ [pToJSVal cb] <> depsArg
--------------------------------------------------------------------------------
-- Not yet supported
--------------------------------------------------------------------------------
type DispatchFunction a = a -> Effect ()
type Reducer s a = s -> a -> s
useContext :: Context a -> Hook a
useContext = undefined
data Context a
createContext :: a -> IO (Context a)
createContext = undefined
provider :: Context a -> a -> Render b -> Render b
provider = undefined
data Ref a
forwardRef :: (props -> Ref refVal -> Hook (Render ())) -> Component props refVal
forwardRef = undefined
useImperativeHandle :: Ref a -> Effect a -> Maybe [JSVal] -> Hook ()
useImperativeHandle = undefined
useReducer :: Reducer s a -> a -> Maybe (a -> a) -> Hook (a, DispatchFunction a)
useReducer = undefined
useTransition :: Hook (Bool, Effect () -> Effect ())
useTransition = undefined
useDeferredValue :: a -> Hook a
useDeferredValue = undefined
useDebugValue :: a -> Maybe (a -> b) -> Hook ()
useDebugValue = undefined
useId :: Hook Text
useId = undefined
useSyncExternalStore :: (IO () -> IO (IO ())) -> IO a -> Maybe (IO a) -> Hook ()
useSyncExternalStore = undefined
newtype Effect a = Effect { unEffect :: JSM a }
deriving (Functor, Applicative, Monad)

View File

@ -1,7 +1,4 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-orphans #-}
-- | Everything in this module belongs in JSaddle, GHCJS-DOM, or similar -- | Everything in this module belongs in JSaddle, GHCJS-DOM, or similar
module React.JSaddle where module React.JSaddle where

View File

@ -1,5 +1,4 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module React.Types where module React.Types where
import Control.Monad.Reader import Control.Monad.Reader
@ -31,16 +30,6 @@ newtype Hook a = Hook { unHook :: ReaderT React JSM a }
#endif #endif
) )
newtype Render a = Render { unRender :: ReaderT React JSM a }
deriving ( Functor
, Applicative
, Monad
, MonadJSM
#ifndef ghcjs_HOST_OS
, MonadIO
#endif
)
newtype Element = Element { unElement :: ReaderT React JSM JSVal } newtype Element = Element { unElement :: ReaderT React JSM JSVal }
instance IsString Element where instance IsString Element where