mad/byg/src/Main.hs

{-# 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 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
  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>"