Make compile

byg/src/ComputationM.hs

@@ -0,0 +1,84 @@
+module ComputationM where
+
+import Unsafe.Coerce (unsafeCoerce)
+import Control.Monad.State
+import Control.Monad.Writer
+
+import Functions
+import Sources
+
+
+data ComputationRun a b = ComputationRun (Function a b)
+                        | ComputationRunIO (FunctionIO a b)
+
+
+
+data TypedRun a b where
+  F :: Function a b -> TypedRun a b
+  FIO' :: IsFIO f a b => f -> TypedRun a b
+  FIO :: FunctionIO a b -> TypedRun a b
+  TInject :: b -> TypedRun () b
+  InList :: ComputationM TokenNotTraversable b -> TypedRun [a] [b]
+
+testtr = FIO' ListDirectory'
+
+instance Show (ComputationM t a) where
+  show _ = "<computation>"
+
+deriving instance (Show a, Show b) => Show (TypedRun a b)
+
+data Token t a where
+  Token :: Int -> Token t a
+  NoToken :: Token t ()
+
+deriving instance Show (Token t a)
+
+data TokenTraversable
+data TokenNotTraversable
+
+instance Functor (Token TokenTraversable) where
+  fmap f (Token n) = Token n
+
+instance Foldable (Token TokenTraversable) where
+  foldr f z (Token n) = z
+
+instance Traversable (Token TokenTraversable) where
+  traverse f (Token n) = (const (Token 33) <$> f (unsafeCoerce (Token n)))
+
+data Dependency ta a tb b = Dependency (Token ta a) (TypedRun a b) (Token tb b)
+  deriving (Show)
+
+data DependencyUntyped where
+  DependencyUntyped :: Dependency ta a tb b -> String -> DependencyUntyped
+
+instance Show DependencyUntyped where
+  show (DependencyUntyped _ s) = s
+
+newtype ComputationM' a = ComputationM { unComputationM :: WriterT [DependencyUntyped] (State Int) a }
+  deriving (Functor, Applicative, Monad, MonadState Int, MonadWriter [DependencyUntyped])
+
+type ComputationM ta a = ComputationM' (Token ta a)
+
+evalComputationM m = evalState (execWriterT (unComputationM m)) 0
+
+genDependency :: (Show u, Show a) => (Token ta a -> Dependency tu u ta a) -> ComputationM ta a
+genDependency g = do
+  top <- get
+  let top' = top + 1
+      target = Token top'
+  put top'
+  let result = g target
+  tell [DependencyUntyped result (show result)]
+  pure target
+
+inject :: Show a => a -> ComputationM ta a
+inject x = genDependency (Dependency NoToken (TInject x))
+
+runIO :: (Show a, Show b) => FunctionIO a b -> Token t a -> ComputationM TokenNotTraversable b
+runIO f input = genDependency (Dependency input (FIO f))
+
+makeTraversable :: Token TokenNotTraversable [a] -> Token TokenTraversable (Token TokenNotTraversable a)
+makeTraversable (Token n) = Token n
+
+mapListTaken :: (Show a, Show b) => ComputationM TokenNotTraversable b -> Token TokenNotTraversable [a] -> ComputationM TokenNotTraversable [b]
+mapListTaken f input = genDependency (Dependency input (InList f))