From 20eaec927eb020b572edac8d25d1dca32e8a4062 Mon Sep 17 00:00:00 2001
From: "Niels G. W. Serup" <ngws@metanohi.name>
Date: Sat, 21 Sep 2024 16:35:13 +0200
Subject: [PATCH] Add initial code approach exploration

For the historical record.
---
 byg/src/Main.hs | 215 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 215 insertions(+)

diff --git a/byg/src/Main.hs b/byg/src/Main.hs
index 2e0e4d3..5eae78b 100644
--- a/byg/src/Main.hs
+++ b/byg/src/Main.hs
@@ -1,4 +1,219 @@
+{-# LANGUAGE GADTs #-}
 module Main where
 
+-- import Data.Maybe (fromMaybe)
+-- import Data.Typeable (cast)
+import Unsafe.Coerce (unsafeCoerce)
+import Control.Monad.State
+import Control.Monad.Writer
+
+data Source a where
+  -- Void :: Source ()
+  Data :: a -> Source a
+
+data Image = Image
+  deriving (Show)
+data ImageConversion = ImageConversion
+  deriving (Show)
+
+data Function a b where
+  IsImageFilename :: Function FilePath Bool
+  ConvertedImageFilename :: Function FilePath FilePath
+
+deriving instance Show (Function a b)
+
+data FunctionIO a b where
+  ListDirectory :: FunctionIO FilePath [FilePath]
+  OpenImage :: FunctionIO FilePath Image
+  ConvertImage :: FunctionIO (Image, ImageConversion) Image
+  Save :: FunctionIO (a, FilePath) ()
+  RunPandoc :: FunctionIO String String
+
+deriving instance Show (FunctionIO a b)
+
+data Computation a b where
+  Pipe :: Computation t u -> Computation u v -> Computation t v
+  Duplicate :: Computation t (t, t)
+  PairWith :: Computation t u -> Computation () u1 -> Computation t (u, u1)
+  TupleComputation :: Computation t0 u0 -> Computation t1 u1 -> Computation (t0, t1) (u0, u1)
+  -- OnFirst :: Computation t0 u0 -> Computation (t0, t1) (u0, u1)
+  -- OnSecond :: Computation t1 u1 -> Computation (t0, t1) (u0, u1)
+  MapComputation :: Computation t u -> Computation [t] [u]
+  MapUnit :: Computation [()] ()
+  FilterComputation :: Computation t Bool -> Computation [t] [t]
+  Inject :: t -> Computation () t
+  Run :: Function t u -> Computation t u
+  RunIO :: FunctionIO t u -> Computation t u
+
+handleImages :: Computation () ()
+handleImages =
+  Inject "retter"
+  `Pipe` (RunIO ListDirectory)
+  `Pipe` FilterComputation (Run IsImageFilename)
+  `Pipe` MapComputation (Duplicate
+                         `Pipe` (TupleComputation
+                                 (PairWith (RunIO OpenImage) (Inject ImageConversion)
+                                  `Pipe` RunIO ConvertImage)
+                                 (Run ConvertedImageFilename))
+                         `Pipe` RunIO Save)
+  `Pipe` MapUnit
+
+
+
+-- 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)
+
+class SourceState a where
+  stateOfSource :: a -> IO ByteString
+  -- makeChecker :: a -> IO (a -> Bool)
+
+instance SourceState FilePath where
+  stateOfSource = undefined
+  -- makeChecker = undefined
+
+class SourceState a => IsFIO f a b | f -> a b where
+  runFIO :: f -> a -> IO 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
+
+--deriving instance Show DependencyUntyped
+
+-- showDU :: DependencyUntyped -> String
+-- showDU (DependencyUntyped d) = show d
+
+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
+  dir <- inject "retter"
+  dirContents <- runIO ListDirectory dir
+  let dirContents' = makeTraversable dirContents
+  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>"