{-# LANGUAGE OverloadedStrings #-}

module Templating (createFiles) where

import qualified Config
import qualified Data.Text.IO      as TextIO
import           System.FilePath   ((</>))
import           System.Posix.Files
import qualified System.IO         as IO
import           System.Process
import           Text.Mustache
import           Text.Parsec.Error (ParseError)

data ScriptSpec = ScriptSpec { interface :: String, dataFilename :: String}

instance ToMustache ScriptSpec where
  toMustache spec = object ["interface" ~> interface spec,
                            "data_filename" ~> dataFilename spec]

data DataSpec = DataSpec { wpaPassphraseOutput :: String}

instance ToMustache DataSpec where
  toMustache spec = object ["wpa_passphrase_output" ~> wpaPassphraseOutput spec]

type Interface = String
type SSID = String
type Passphrase = String

createScript :: FilePath -> Interface -> FilePath -> IO (Either ParseError FilePath)
createScript filename iface dataFile =
  createFile filename Config.scriptDir scriptSpec "script.mustache"
  where scriptSpec = ScriptSpec { interface = iface, dataFilename = dataFile }

runWPAPassphrase :: SSID -> Passphrase -> IO String
runWPAPassphrase ssid passphrase = do
  (_, Just hout, _, _) <- createProcess wpa_passphrase_process
                          { std_out = CreatePipe }
  IO.hGetContents hout
  where wpa_passphrase_process = (proc "wpa_passphrase" [ssid, passphrase])

createData :: FilePath -> String -> IO (Either ParseError FilePath)
createData filename wpaPPoutput =
  createFile filename Config.dataDir dataSpec "data.mustache"
  where dataSpec = DataSpec {wpaPassphraseOutput = wpaPPoutput}

createFile :: ToMustache a => FilePath -> IO FilePath -> a -> FilePath
  -> IO (Either ParseError FilePath)
createFile filename outputDirFunc spec templateFile = do
  templateDir <- Config.templateDir
  outputDir <- outputDirFunc
  compiled <- automaticCompile [templateDir] templateFile
  let outputPath = outputDir </> filename
  case compiled of
    Left err -> return (Left err)
    Right template -> do
      TextIO.writeFile outputPath $ substitute template spec
      return (Right outputPath)

createFiles :: FilePath -> Interface -> SSID -> Passphrase
  -> IO (FilePath, FilePath)
createFiles filename iface ssid passphrase = do
  wpaPPoutput <- runWPAPassphrase ssid passphrase
  (Right dataFile) <- createData filename wpaPPoutput
  (Right scriptFile) <- createScript filename iface dataFile
  setFileMode scriptFile ownerModes
  setFileMode dataFile (unionFileModes ownerWriteMode ownerReadMode)
  return (dataFile, scriptFile)