module B9.B9Config.Repository ( RemoteRepo(..)
                              , remoteRepoRepoId
                              , RepoCache(..)
                              , SshPrivKey(..)
                              , SshRemoteHost(..)
                              , SshRemoteUser(..)
                              , remoteRepoToConfigParser
                              , parseRemoteRepos
                              ) where

import Data.Data
import Data.List (isSuffixOf)
import Data.ConfigFile

newtype RepoCache = RepoCache FilePath
  deriving (Read, Show, Typeable, Data)

data RemoteRepo = RemoteRepo String
                             FilePath
                             SshPrivKey
                             SshRemoteHost
                             SshRemoteUser
  deriving (Read, Show, Typeable, Data)

remoteRepoRepoId :: RemoteRepo -> String
remoteRepoRepoId (RemoteRepo repoId _ _ _ _) = repoId

newtype SshPrivKey = SshPrivKey FilePath
  deriving (Read, Show, Typeable, Data)

newtype SshRemoteHost = SshRemoteHost (String,Int)
  deriving (Read, Show, Typeable, Data)

newtype SshRemoteUser = SshRemoteUser String
  deriving (Read, Show, Typeable, Data)


-- | Persist a repo to a configuration file.
remoteRepoToConfigParser :: RemoteRepo
                      -> ConfigParser
                      -> Either CPError ConfigParser
remoteRepoToConfigParser repo cpIn = cpWithRepo
  where section = repoId ++ repoSectionSuffix
        (RemoteRepo repoId
                    remoteRootDir
                    (SshPrivKey keyFile)
                    (SshRemoteHost (host,port))
                    (SshRemoteUser user)) = repo
        cpWithRepo = do cp1 <- add_section cpIn section
                        cp2 <- set cp1 section repoRemotePathK remoteRootDir
                        cp3 <- set cp2 section repoRemoteSshKeyK keyFile
                        cp4 <- set cp3 section repoRemoteSshHostK host
                        cp5 <- setshow cp4 section repoRemoteSshPortK port
                        set cp5 section repoRemoteSshUserK user

-- | Load a repository from a configuration file that has been written by
-- 'writeRepositoryToB9Config'.
parseRemoteRepos :: ConfigParser -> Either CPError [RemoteRepo]
parseRemoteRepos cp = traverse parseRepoSection repoSections
  where
    repoSections =
          filter (repoSectionSuffix `isSuffixOf`) (sections cp)
    parseRepoSection section = parseResult
      where
        getsec :: Get_C a =>  OptionSpec -> Either CPError a
        getsec = get cp section
        parseResult =
          RemoteRepo repoId
            <$> getsec repoRemotePathK
            <*> (SshPrivKey <$> getsec repoRemoteSshKeyK)
            <*> (SshRemoteHost <$> ((,) <$> getsec repoRemoteSshHostK
                                        <*> getsec repoRemoteSshPortK))
            <*> (SshRemoteUser <$> getsec repoRemoteSshUserK)
          where
            repoId = let prefixLen = length section - suffixLen
                         suffixLen = length repoSectionSuffix
                         in take prefixLen section

repoSectionSuffix :: String
repoSectionSuffix = "-repo"
repoRemotePathK :: String
repoRemotePathK = "remote_path"
repoRemoteSshKeyK :: String
repoRemoteSshKeyK = "ssh_priv_key_file"
repoRemoteSshHostK :: String
repoRemoteSshHostK = "ssh_remote_host"
repoRemoteSshPortK :: String
repoRemoteSshPortK = "ssh_remote_port"
repoRemoteSshUserK :: String
repoRemoteSshUserK = "ssh_remote_user"