ngws
/
mad
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Give types back to Action

This commit is contained in:
Niels G. W. Serup 2024-10-14 20:50:55 +02:00
parent f29dd6d299
commit b23aa99b15
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
2 changed files with 17 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
byg/src/DependencyRunner.hs
View File

@ -86,7 +86,7 @@ tupApp ta tb = App (App (typeRep @(,)) ta) tb
listApp :: TypeRep a -> TypeRep [a] listApp :: TypeRep a -> TypeRep [a]
listApp ta = App (typeRep @[]) ta listApp ta = App (typeRep @[]) ta
runAction :: Action -> Value -> DepRunM Value runAction :: Action a b -> Value -> DepRunM Value
runAction action input = case action of runAction action input = case action of
Function f -> Function f ->
pure $ toValue $ evalFunction f $ fromValue input pure $ toValue $ evalFunction f $ fromValue input

31
byg/src/Types/Dependency.hs
View File

@ -19,19 +19,19 @@ import Text.Printf (printf)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
data Action where data Action a b where
Function :: IsFunction f a b => f -> Action Function :: IsFunction f a b => f -> Action a b
InlineFunction :: Show b => TypeRep a -> TypeRep b -> F a b -> Action InlineFunction :: Show b => TypeRep a -> TypeRep b -> F a b -> Action a b
FunctionIO :: IsFunctionIO f a b => f -> Action FunctionIO :: IsFunctionIO f a b => f -> Action a b
Inject :: Value -> Action Inject :: Value -> Action () a
FilterComp :: Show a => TypeRep a -> Action FilterComp :: Show a => TypeRep a -> Action ([a], [Bool]) [a]
UntupleFst :: (Show a, Show b) => TypeRep a -> TypeRep b -> Action UntupleFst :: (Show a, Show b) => TypeRep a -> TypeRep b -> Action (a, b) a
UntupleSnd :: (Show a, Show b) => TypeRep a -> TypeRep b -> Action UntupleSnd :: (Show a, Show b) => TypeRep a -> TypeRep b -> Action (a, b) b
UnzipFst :: (Show a, Show b) => TypeRep a -> TypeRep b -> Action UnzipFst :: (Show a, Show b) => TypeRep a -> TypeRep b -> Action [(a, b)] [a]
UnzipSnd :: (Show a, Show b) => TypeRep a -> TypeRep b -> Action UnzipSnd :: (Show a, Show b) => TypeRep a -> TypeRep b -> Action [(a, b)] [b]
MapComp :: (Typeable a, Show a, Typeable b, Show b) => TypeRep a -> TypeRep b -> [Dependency] -> Token a -> Token b -> Action MapComp :: (Typeable a, Show a, Typeable b, Show b) => TypeRep a -> TypeRep b -> [Dependency] -> Token a -> Token b -> Action [a] [b]
deriving instance Show Action deriving instance Show (Action a b)
newtype F a b = F (a -> b) newtype F a b = F (a -> b)
@ -39,10 +39,10 @@ instance Show (F a b) where
show = const "<function>" show = const "<function>"
data Dependency where data Dependency where
Dependency :: (Typeable a, Show a) => TypeRep a -> Token a -> Action -> TypeRep b -> Token b -> Dependency Dependency :: (Typeable a, Show a) => TypeRep a -> Token a -> Action a b -> TypeRep b -> Token b -> Dependency
deriving instance Show Dependency deriving instance Show Dependency
makeDependency :: (Typeable a, Show a, Typeable b, Show b) => Token a -> Action -> Token b -> Dependency makeDependency :: (Typeable a, Show a, Typeable b, Show b) => Token a -> Action a b -> Token b -> Dependency
makeDependency a action b = Dependency typeRep a action typeRep b makeDependency a action b = Dependency typeRep a action typeRep b
unListType :: Typeable a => TypeRep [a] -> TypeRep a unListType :: Typeable a => TypeRep [a] -> TypeRep a
@ -51,7 +51,7 @@ unListType _ = typeRep
unTupleType :: (Typeable a, Typeable b) => TypeRep (a, b) -> (TypeRep a, TypeRep b) unTupleType :: (Typeable a, Typeable b) => TypeRep (a, b) -> (TypeRep a, TypeRep b)
unTupleType _ = (typeRep, typeRep) unTupleType _ = (typeRep, typeRep)
actionTouchesFilesystem :: Action -> Bool actionTouchesFilesystem :: Action a b -> Bool
actionTouchesFilesystem = \case actionTouchesFilesystem = \case
Function _ -> False Function _ -> False
InlineFunction _ _ _ -> False InlineFunction _ _ _ -> False
@ -105,6 +105,7 @@ formatDependencyTrees = T.concat . (formatDependencyTrees' "")
NoToken -> NoToken ->
[ "--" ] [ "--" ]
formatAction :: Text -> Action a b -> [Text]
formatAction indentation = \case formatAction indentation = \case
MapComp _ _ subDeps innerInput innerOutput -> MapComp _ _ subDeps innerInput innerOutput ->
concat [ [ "MapComp(" ] concat [ [ "MapComp(" ]