content: module Main where
  import System.Directory
  import System.FilePath
  import qualified Data.Text
  import qualified CedilleParser
  import GHC.IO.Encoding
  
  templatesDir = "src" </> "templates"
  agda = "src" </> "templates.agda"
  hs = "src" </> "Templates.hs"
  
  writeMsg f = appendFile f . flip (++) "\n"
  writeGenComment f = writeMsg f ("-- Generated by " ++ templatesDir </> "TemplatesCompiler")
  writeHdrAgda =
    writeFile agda "" >>
    writeGenComment agda >>
    writeMsg agda "module templates where" >>
    -- writeMsg "open import lib" >>
    writeMsg agda "open import cedille-types" >>
    writeMsg agda "{-# FOREIGN GHC import qualified Templates #-}"
  writeHdrHs =
    writeFile hs "" >>
    writeGenComment hs >>
    writeMsg hs "{-# LANGUAGE OverloadedStrings #-}" >>
    writeMsg hs "module Templates where" >>
    writeMsg hs "import CedilleTypes" >>
    writeMsg hs "import qualified Data.Text"
    
  
  readFiles = flip foldr (return []) $
    \ f xsio -> readFile f >>= \ fc -> xsio >>= return . ((:) (f, fc))
  addPfxs = map $ (</>) templatesDir
  getCedFiles = filter $ \ f -> takeExtension f == ".ced"
  parseStrings = map $ \ (f, fc) ->
    (f, CedilleParser.parseTxt $ Data.Text.pack fc)
  errMsg f (Left p) =
    "Lexical error in file " ++ f ++ " at position " ++ Data.Text.unpack p
  errMsg f (Right p) =
    "Parse error in file " ++ f ++ " at position " ++ Data.Text.unpack p
  
  writeMsgs =
    flip foldl (return ()) $ \ x (f, p) ->
      flip (either (error . errMsg f)) p $ \ pt ->
        let f' = "template" ++ takeBaseName f
            c = "\n\n" ++ "-- " ++ f ++ "\n" in
        putStrLn ("Generating template " ++ takeBaseName f) >>
        writeMsg agda (c ++ "postulate\n  " ++ f' ++ " : start") >>
        writeMsg agda ("{-# COMPILE GHC " ++ f' ++ " = Templates." ++ f' ++ " #-}") >>
        writeMsg hs (c ++ f' ++ " = " ++ show pt) >> x
  
  main =
    setLocaleEncoding utf8 >>
    writeHdrAgda >> writeHdrHs >>
    getDirectoryContents templatesDir >>=
    readFiles . addPfxs . getCedFiles >>=
    writeMsgs . parseStrings  
  