Use InList properly
This commit is contained in:
		
							parent
							
								
									af2b9202ef
								
							
						
					
					
						commit
						d0c2b47df0
					
				| @ -1,4 +1,3 @@ | |||||||
| {-# LANGUAGE GADTs #-} |  | ||||||
| module ComputationM where | module ComputationM where | ||||||
| 
 | 
 | ||||||
| import Types | import Types | ||||||
| @ -16,7 +15,8 @@ data TypedRun a b where | |||||||
|   FIO :: IsFIO f a b => f -> TypedRun a b |   FIO :: IsFIO f a b => f -> TypedRun a b | ||||||
|   TInject :: b -> TypedRun () b |   TInject :: b -> TypedRun () b | ||||||
|   GetListElem :: TypedRun () b |   GetListElem :: TypedRun () b | ||||||
|   InList :: ComputationM b -> TypedRun [a] [b] |   SetListElem :: TypedRun a () | ||||||
|  |   InList :: [DependencyUntyped] -> TypedRun [a] [b] | ||||||
| 
 | 
 | ||||||
| instance Show (ComputationM a) where | instance Show (ComputationM a) where | ||||||
|   show _ = "<computation>" |   show _ = "<computation>" | ||||||
| @ -43,6 +43,7 @@ newtype ComputationM' a = ComputationM { unComputationM :: WriterT [DependencyUn | |||||||
| 
 | 
 | ||||||
| type ComputationM a = ComputationM' (Token a) | type ComputationM a = ComputationM' (Token a) | ||||||
| 
 | 
 | ||||||
|  | evalComputationM :: ComputationM () -> [DependencyUntyped] | ||||||
| evalComputationM m = evalState (execWriterT (unComputationM m)) 0 | evalComputationM m = evalState (execWriterT (unComputationM m)) 0 | ||||||
| 
 | 
 | ||||||
| genDependency :: (Show u, Show a) => (Token a -> Dependency u a) -> ComputationM a | genDependency :: (Show u, Show a) => (Token a -> Dependency u a) -> ComputationM a | ||||||
| @ -61,6 +62,9 @@ inject x = genDependency (Dependency NoToken (TInject x)) | |||||||
| getListElem :: Show a => ComputationM a | getListElem :: Show a => ComputationM a | ||||||
| getListElem = genDependency (Dependency NoToken GetListElem) | getListElem = genDependency (Dependency NoToken GetListElem) | ||||||
| 
 | 
 | ||||||
|  | setListElem :: Show a => Token a -> ComputationM () | ||||||
|  | setListElem a = genDependency (Dependency a SetListElem) | ||||||
|  | 
 | ||||||
| run :: (Show a, Show b, IsF f a b) => f -> Token a -> ComputationM b | run :: (Show a, Show b, IsF f a b) => f -> Token a -> ComputationM b | ||||||
| run f input = genDependency (Dependency input (F f)) | run f input = genDependency (Dependency input (F f)) | ||||||
| 
 | 
 | ||||||
| @ -76,5 +80,10 @@ convertImage = runIO ConvertImage | |||||||
| saveFile = runIO SaveFile | saveFile = runIO SaveFile | ||||||
| runPandoc = runIO RunPandoc | runPandoc = runIO RunPandoc | ||||||
| 
 | 
 | ||||||
| mapListTaken :: (Show a, Show b) => ComputationM b -> Token [a] -> ComputationM [b] | mapListTaken :: (Show a, Show b) => (Token a -> ComputationM b) -> Token [a] -> ComputationM [b] | ||||||
| mapListTaken f input = genDependency (Dependency input (InList f)) | mapListTaken f input = genDependency (Dependency input (InList (evalComputationM m))) | ||||||
|  |   where m :: ComputationM () | ||||||
|  |         m = do | ||||||
|  |           inp <- getListElem | ||||||
|  |           outp <- f inp | ||||||
|  |           setListElem outp | ||||||
|  | |||||||
| @ -3,16 +3,11 @@ module Main where | |||||||
| import Types | import Types | ||||||
| import ComputationM | import ComputationM | ||||||
| 
 | 
 | ||||||
| testSub :: ComputationM Image |  | ||||||
| testSub = do |  | ||||||
|   inp <- getListElem |  | ||||||
|   openImage inp |  | ||||||
| 
 |  | ||||||
| test :: ComputationM () | test :: ComputationM () | ||||||
| test = do | test = do | ||||||
|   dir <- inject "retter" |   dir <- inject "retter" | ||||||
|   dirContents <- listDirectory dir |   dirContents <- listDirectory dir | ||||||
|   u <- mapListTaken testSub dirContents |   u <- mapListTaken openImage dirContents | ||||||
|   pure $ NoToken |   pure $ NoToken | ||||||
| 
 | 
 | ||||||
| main :: IO () | main :: IO () | ||||||
|  | |||||||
		Loading…
	
	
			
			x
			
			
		
	
		Reference in New Issue
	
	Block a user