Make compile

byg/byg.cabal

@@ -16,6 +16,10 @@ common common
 executable byg
     import:           common
     main-is:          Main.hs
+    other-modules:
+        Sources
+        Functions
+        ComputationM
     hs-source-dirs:   src
     build-depends:
         base

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))

byg/src/Functions.hs

@@ -1,6 +1,8 @@
 {-# LANGUAGE GADTs #-}
 module Functions where
 
+import Sources
+
 data Image = Image
   deriving (Show)
 data ImageConversion = ImageConversion
@@ -20,3 +22,9 @@ data FunctionIO a b where
   RunPandoc :: FunctionIO String String
 
 deriving instance Show (FunctionIO a b)
+
+
+data ListDirectory' = ListDirectory'
+  deriving (Show)
+instance IsFIO ListDirectory' FilePath [FilePath] where
+  runFIO ListDirectory' path = undefined

byg/src/Main.hs

@@ -1,97 +1,7 @@
-{-# LANGUAGE GADTs #-}
 module Main where
 
--- import Data.Maybe (fromMaybe)
+import Functions
--- import Data.Typeable (cast)
+import ComputationM
-import Unsafe.Coerce (unsafeCoerce)
-import Control.Monad.State
-import Control.Monad.Writer
-
-
--- data FlatComputation = Flat
-
--- handleImagesFlatManuallyWritten =
---   [ (FlatRunIO ListDirectory, FlatInject "retter", TargetList 0)
---   , (FlatRun IsImageFilename, FilteredList 0, TargetList 1)
---   , (FlatRunIO OpenImage, EachOfList 1, Target 2)
---   , (FlatPairWith ImageConversion, Source 2, Target 3)
---   , (FlatRunIO ConvertImage, Source 3, Target 4)
---   , ...
---   ]
-
-data ComputationRun a b = ComputationRun (Function a b)
-                        | ComputationRunIO (FunctionIO a b)
-
-
-data ListDirectory' = ListDirectory'
-instance IsFIO ListDirectory' FilePath [FilePath] where
-  runFIO ListDirectory' path = undefined
-
-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 ta a = ComputationM { unComputationM :: WriterT [DependencyUntyped] (State Int) (Token ta a) }
-  deriving (Monad)
-
-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 :: ComputationM TokenNotTraversable b -> Token TokenNotTraversable [a] -> ComputationM TokenNotTraversable [b]
-mapListTaken f input = genDependency (Dependency input (InList f))
 
 test :: ComputationM TokenNotTraversable ()
 test = do
@@ -101,52 +11,5 @@ test = do
   u <- mapM (runIO OpenImage) dirContents'
   pure $ NoToken
 
-test1 = mapM_ print $ evalState (execWriterT (unComputationM test)) 0
-
--- monadTestHandleImages :: ComputationM ()
--- monadTestHandleImages = do
---   dir <- inject "retter"
---   dirContents <- runIO ListDirectory dir
---   dirImagePaths <- filterM (run IsImageFilename) dirContents
---   forM_ dirImagePaths $ \path -> do
---     image <- runIO OpenImage path
---     conv <- inject ImageConversion
---     imageConverted <- runIO ConvertImage (image, conv)
---     saveFilename <- run ConvertedImageFilename path
---     runIO Save (image, saveFilename)
-
-
-
-
-
--- listDirectory :: FilePath -> IO [FilePath]
--- listDirectory = undefined
-
--- isImageFilename :: FilePath -> Bool
--- isImageFilename = undefined
-
--- data Computation a b = Data b
---                      | Pipe (Source a) (Target b)
-
--- instance Computation ListDirectory where
---   Target [Source String]
-
--- buildRecipe dir = do
---   files <- listDirectory dir
---   let imageFiles = filter isImageFilename files
---   images <- mapM (resizeImage . loadImage) imageFiles
---   mapM (\(image, filename) -> (save (imageData image) (filename ^ "resized")) (zip images imageFiles)
-
--- buildIndex = do
---   listDirectory
-
--- gen = do
---   -- build "index.html"
---   recipeDirs <- listDirectory "retter"
---   mapM_ buildRecipe recipeDirs
-
--- main :: IO ()
--- main = runBygM gen
-
 main :: IO ()
-main = putStrLn "<html>"
+main = mapM_ print $ evalComputationM test

byg/src/Sources.hs

@@ -12,5 +12,5 @@ class SourceState a where
 instance SourceState FilePath where
   stateOfSource = undefined
 
-class SourceState a => IsFIO f a b | f -> a b where
+class (SourceState a, Show f) => IsFIO f a b | f -> a b where
   runFIO :: f -> a -> IO b