{-# Language DeriveDataTypeable #-}
{-# Language RecordWildCards #-}

module Main where

import Paths_hblend (version)
import Data.Version (showVersion)
import System.Console.CmdArgs.Implicit
import System.Directory (createDirectory)
import System.FilePath ((</>))
import System.IO (hPutStrLn, withFile, IOMode(WriteMode))

import qualified Data.ByteString.Char8 as BC

import Control.Monad ((<=<))

import Data.Blend
import Data.Blend.Types
import Data.Blend.Html (dumpHtml)
{-
  ( BBlend(..)
  , readBHeader, readBBlend
  , blendHeader, blendSdna
  , versionNumber
  , showSDNAAsHs, showSDNAAsSDNA
  , lookupStruct, showStruct
  , showStructAsHs, showStructAsHtml, showStructAsStruct, showStructParser
  , showBlockParser
  )
-}
versionString :: String
versionString =
  "hblend " ++ showVersion version ++ " Copyright (c) 2009-2011 Vo Minh Thu."

autogeneratedMessage :: String
autogeneratedMessage =
  "-- Automatically generated by hblend "
  ++ showVersion version ++ "."

main :: IO ()
main = (processCmd =<<) $ cmdArgs $
  modes
    [ dump, header, struct
    ]
  &= summary versionString
  &= program "hblend"

data DumpFormat = Code | Haskell | Html
  deriving (Data, Typeable)

data Cmd =
    Dump
    { dumpFormat :: DumpFormat
    , dumpFile :: FilePath
    }
  | Header
    { headerFiles :: [FilePath]
    }
  | Struct
    { structFile :: FilePath
    , structName :: String
    }
  deriving (Data, Typeable)

dump :: Cmd
dump = Dump
  { dumpFormat = Haskell
    &= typ "FORMAT"
    &= help "dump format"
    &= explicit
    &= name "f"
    &= name "format"
  , dumpFile = "" -- TODO mandatory
    &= typ "BLEND"
    &= help "blend filename"
    &= explicit
    &= name "b"
    &= name "blend-file"
  } &= help "Dump some information from a blend file."

header :: Cmd
header = Header
  { headerFiles = def
    &= typ "BLEND FILES"
    &= args
  } &= help "Dump the version header of blend files."

struct :: Cmd
struct = Struct
  { structName = def
    &= typ "STRING"
    &= help "structure name"
    &= explicit
    &= name "s"
    &= name "struct"
  , structFile = "" -- TODO mandatory
    &= typ "BLEND"
    &= help "blend filename"
    &= explicit
    &= name "b"
    &= name "blend-file"
  } &= help "Extract information for a specific structure from a blend file."

processCmd :: Cmd -> IO ()
processCmd Dump{..} = do
  blend <- readBBlend dumpFile
  case dumpFormat of
    Code -> dumpCode blend
    Haskell -> print blend
    Html -> dumpHtml blend

processCmd Header{..} = do
  mapM_ (print <=< readBHeader) headerFiles

processCmd Struct{..} = do
  blend <- readBBlend structFile
  case lookupStruct blend structName of
    Nothing -> putStrLn "No such structure."
    Just fs -> putStrLn $ showStruct fs
 
dumpCode :: BBlend -> IO ()
dumpCode blend = do
  let sdna = blendSdna blend
      v = BC.unpack . versionNumber $ blendHeader blend
      dir = 'B' : v
  createDirectory dir
  withFile (dir </> "SDNA.hs") WriteMode $ \hsdna -> do
    hPutStrLn hsdna $
      "{-# LANGUAGE OverloadedStrings #-}\n"
      ++ autogeneratedMessage ++
      "\nmodule Data.Blend.B" ++ v ++ ".SDNA where\n\n\
      \import Data.Blend.Types\n"
    mapM_ (hPutStrLn hsdna . showStructAsStruct) sdna
    hPutStrLn hsdna $ showSDNAAsSDNA sdna

  withFile (dir </> "Types.hs") WriteMode $ \htypes -> do
    hPutStrLn htypes $
      "{-# LANGUAGE OverloadedStrings #-}\n"
      ++ autogeneratedMessage ++
      "\nmodule Data.Blend.B" ++ v ++ ".Types where\n\n\
      \import Data.Int\n\
      \import Data.ByteString (ByteString)\n\n\
      \import Data.Blend.Types hiding (Block)\n"
    mapM_ (hPutStrLn htypes . showStructAsHs) sdna
    hPutStrLn htypes $ showSDNAAsHs sdna

  withFile (dir </> "Parser.hs") WriteMode $ \hparser -> do
    hPutStrLn hparser $
      "{-# LANGUAGE OverloadedStrings #-}\n"
      ++ autogeneratedMessage ++
      "\nmodule Data.Blend.B" ++ v ++ ".Parser where\n\n\
      \import qualified Data.ByteString.Lazy as LB\n\
      \import qualified Data.ByteString.Char8 as BC\n\
      \import Data.Binary\n\
      \import Data.Binary.Get (getByteString, getWord32le, runGet)\n\
      \import Control.Monad (replicateM)\n\n\
      \import Data.Blend\n\
      \import Data.Blend.Types hiding (Block)\n\
      \import Data.Blend.Parser\n\n\
      \import Data.Blend.B245.SDNA (sdna)\n\
      \import Data.Blend.B245.Types\n"
    mapM_ (hPutStrLn hparser . showStructParser) sdna
    hPutStrLn hparser $ showBlockParser sdna

  withFile (dir ++ ".hs") WriteMode $ \h -> do
    hPutStrLn h $
      autogeneratedMessage ++
      "\nmodule Data.Blend.B" ++ v ++ "\n\
      \  ( module Data.Blend.B" ++ v ++ ".SDNA\n\
      \  , module Data.Blend.B" ++ v ++ ".Types\n\
      \  , module Data.Blend.B" ++ v ++ ".Parser\n\
      \  )\n\
      \  where\n\n\
      \import Data.Blend.B" ++ v ++ ".SDNA\n\
      \import Data.Blend.B" ++ v ++ ".Types\n\
      \import Data.Blend.B" ++ v ++ ".Parser"
