{-# LANGUAGE FlexibleInstances #-}
module Development.Cake3.Writer (toMake) where

import Control.Monad (when)
import Control.Applicative
import Control.Monad.State (State(..), execState, runState, modify, get, put)
import Data.List as L
import Data.Char
import Data.String
import Data.Foldable (forM_)
import Data.Traversable (forM)
import Data.Set (Set)
import qualified Data.Set as S
import Data.Map (Map)
import qualified Data.Map as M
import Text.Printf

import System.FilePath.Wrapper
import Development.Cake3.Types
import Development.Cake3.Monad

gen :: MakeWriter Int
gen = do
  x <- head <$> cnt <$> get
  modify (\ws -> ws { cnt = tail (cnt ws) })
  return x

-- | Writer state
data WS = WS { cnt :: [Int] , ls :: String }
  deriving(Show)

type MakeWriter a = State WS a

class ToMakeText x where
  toMakeText :: x -> String
  
instance ToMakeText [Char] where
  toMakeText = id

instance ToMakeText [[Char]] where
  toMakeText = concat . map toMakeText

-- instance ToMakeText (Set File) where
--   toMakeText = concat . map toMakeText . S.toList

instance ToMakeText File where
  toMakeText (FileT f) = escape f where
    escape [] = []
    escape (' ':xs) = "\\ " ++ escape xs
    escape (x:xs) = (x:(escape xs))

trimE = dropWhileEnd isSpace
trimB = dropWhile isSpace

cs a b = a ++ (' ':b)

instance ToMakeText Command where
  toMakeText [x] = either toMakeText toMakeText x
  toMakeText ((Left str):(Right f):cmd) = toMakeText ((Left ((trimE str)`cs` (toMakeText f))):cmd)
  toMakeText ((Right f):(Left str):cmd) = toMakeText ((Left ((toMakeText f)`cs`(trimB str))):cmd)
  toMakeText ((Right a):(Right b):cmd) = toMakeText ((Left ((toMakeText a)`cs`(toMakeText b))):cmd)
  toMakeText ((Left s1):(Left s2):cmd) = toMakeText ((Left (s1++s2)):cmd)

line :: String -> MakeWriter ()
line s = modify $ \ws -> ws { ls = concat [ls ws, s, "\n"] }

mmap f = map (f . snd) . M.toList
smap f = map f . S.toList

toMake :: (Map String Variable, Map Target Recipe2, [Target]) -> String
toMake (vs_, rs_, p) = 
  let (vs,rs) = (map snd $ M.toList vs_, applyPlacement rs_ p)
  in ls $ flip execState (WS [1..] "") $ do
  line "# This Makefile was generated by the ThirdCake"
  line "# https://github.com/grwlf/cake3"
  line ""

  when (not (null vs)) $ do
    line "GUARD = .GUARD_$(1)_$(shell echo $($(1)) | md5sum | cut -d ' ' -f 1)"

  -- Variables
  forM_ vs $ \v -> case v of
    (Variable n (Just v)) -> line (printf "%s = %s" n v)
    (Variable n Nothing) -> return ()

  -- Rules
  forM_ rs $ \r -> do
    let varguard v = printf "$(call GUARD,%s)" (vname v)
    let deps = intercalate " " $ (smap toMakeText (rsrc r)) ++ (mmap varguard (rvars r))
    let tgts = intercalate " " $ (smap toMakeText (rtgt r))

    when (rphony r) $ do
      line (printf ".PHONY: %s" tgts)

    case (S.size (rtgt r)) of
      0 -> do
        return ()
      1 -> do
        let s = (S.findMin (rtgt r))
        line $ printf "%s: %s" (toMakeText s) deps
        forM_ (rcmd r) $ \c -> do
          line (printf "\t%s" (toMakeText c))
      _ -> do
        i <- gen
        let s = (printf "stamp%d" i :: String)
        line (printf "%s: %s" tgts s)
        line (printf ".INTERMEDIATE: %s" s)
        line (printf "%s: %s" s deps)
        forM_ (rcmd r) $ \c -> do
          line (printf "\t%s" (toMakeText c))

  -- Rules for variable's guards
  -- FIXME: add those on the higher level
  forM_ vs $ \v -> do
    line (printf "$(call GUARD,%s):" (vname v))
    line (printf "\trm -f .GUARD_%s_*" (vname v))
    line "\ttouch $@"