module Development.Rattle.Shared(
    Shared, withShared,
    getSpeculate, setSpeculate,
    getFile, setFile,
    getCmdTraces, addCmdTrace,
    nextRun, lastRun,
    dump
    ) where

import General.Extra
import Development.Rattle.Types
import Development.Rattle.Hash
import General.FileName
import System.Directory.Extra
import System.FilePath
import System.IO.Extra
import Data.Maybe
import Data.List
import Control.Monad.Extra
import Control.Concurrent.Extra
import qualified Data.ByteString as BS
import General.FileInfo
import General.Binary
import Data.Monoid
import Prelude

---------------------------------------------------------------------
-- PRIMITIVES

data Shared = Shared Lock FilePath Bool

withShared :: FilePath -> Bool -> (Shared -> IO a) -> IO a
withShared dir multiple act = do
    lock <- newLock
    createDirectoryRecursive dir
    act $ Shared lock dir multiple

filenameHash :: Hash -> String
filenameHash str = let (a:b:cs) = hashHex str in [a,b] </> cs

filenameValue :: BinaryEx a => a -> String
filenameValue = filenameHash . hashByteString . runBuilder . putEx

getList :: (BinaryEx a, BinaryEx b) => String -> Shared -> a -> IO [b]
getList typ (Shared lock dir _) name = withLock lock $ do
    let file = dir </> typ </> filenameValue name
    b <- doesFileExist file
    if not b then pure [] else map getEx . getExList <$> BS.readFile file

setList :: (Show a, BinaryEx a, BinaryEx b) => String -> IOMode -> Shared -> a -> [b] -> IO ()
setList typ mode (Shared lock dir multiple) name vals = withLock lock $ do
    let mode2 = if multiple then mode else WriteMode
    let file = dir </> typ </> filenameValue name
    createDirectoryRecursive $ takeDirectory file
    unlessM (doesFileExist $ file <.> "txt") $
        writeFile (file <.> "txt") $ show name
    withFile file mode2 $ \h -> do
        hSetEncoding h utf8
        BS.hPutStr h $ runBuilder $ putExList $ map putEx vals

---------------------------------------------------------------------
-- SPECIAL SUPPORT FOR FILES

getFile :: Shared -> Hash -> IO (Maybe (FileName -> IO ()))
getFile (Shared lock dir _) hash = do
    let file = dir </> "files" </> filenameHash hash
    b <- doesFileExist file
    pure $ if not b then Nothing else Just $ \out -> do
      let x = fileNameToString out
      createDirectoryRecursive $ takeDirectory x
      copyFile file x

setFile :: Shared -> FileName -> Hash -> IO Bool -> IO ()
setFile (Shared lock dir _) source hash check = do
    let file = dir </> "files" </> filenameHash hash
    unlessM (doesFileExist file) $ withLock lock $ do
        createDirectoryRecursive $ takeDirectory file
        copyFile (fileNameToString source) (file <.> "tmp")
        good <- check
        if not good then
            removeFile $ file <.> "tmp"
         else
            renameFile (file <.> "tmp") file


---------------------------------------------------------------------
-- TYPE SAFE WRAPPERS

nextRun :: Shared -> String -> IO RunIndex
nextRun share name = do
    t <- maybe runIndex0 nextRunIndex . listToMaybe <$> getList "run" share name
    setList "run" WriteMode share name [t]
    pure t

lastRun :: Shared -> String -> IO (Maybe RunIndex)
lastRun share name = listToMaybe <$> getList "run" share name

getSpeculate :: Shared -> String -> IO [Cmd]
getSpeculate = getList "speculate"

setSpeculate :: Shared -> String -> [Cmd] -> IO ()
setSpeculate = setList "speculate" WriteMode

-- Intermediate data type which puts spaces in the right places to get better
-- word orientated diffs when looking at the output in a text editor
data File = File FileName ModTime Hash
    deriving (Show)

instance BinaryEx File where
    getEx x = File (byteStringToFileName a) b (getEx c)
        where (b,ca) = binarySplit x
              (c,a) = BS.splitAt hashLength ca
    putEx (File a b c) = putExStorable b <> putEx c <> putEx (fileNameToByteString a)


-- First trace in list is earliest one; last is latest one.
getCmdTraces :: Shared -> Cmd -> IO [Trace (FileName, ModTime, Hash)]
getCmdTraces shared cmd = map (fmap fromFile) <$> getList "command" shared cmd
    where fromFile (File path mt x) = (path, mt, x)

addCmdTrace :: Shared -> Cmd -> Trace (FileName, ModTime, Hash) -> IO ()
addCmdTrace share cmd t = setList "command" AppendMode share cmd [fmap toFile t]
    where toFile (path, mt, x) = File path mt x


---------------------------------------------------------------------
-- DUMPING

dumpList :: (String -> IO ()) -> FilePath -> String -> IO ()
dumpList out dir name = do
    out ""
    out $ "## " ++ name
    dirs <- listDirectories $ dir </> name
    forM_ dirs $ \x -> do
        files <- filter (".txt" `isSuffixOf`) <$> listFiles x
        forM_ files $ \file -> do
            out ""
            name <- readFileUTF8' file
            out $ "### " ++ name
            out =<< readFileUTF8' (dropExtension file)


dump :: (String -> IO ()) -> FilePath -> IO ()
dump out dir = do
    out $ "# Rattle dump: " ++ dir
    mapM_ (dumpList out dir) ["run","speculate","command"]