{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-warnings-deprecations #-}

module Projmd.Project
   ( Project (..)
   , getProjects )
   where

import Control.Monad.Error
import Control.Monad.Reader
import System.Directory
import System.FilePath
import Text.Printf
import Text.Regex

import Projmd.Config


data Project = Project
   { pName :: String
   , pSynopsis :: String
   , pPage :: String
   , pSource :: String
   }
   deriving Show


instance Error () where
   noMsg = ()


type Env = Config

type ProjM a = ReaderT Env (ErrorT () IO) a


runProjM :: Env -> ProjM a -> IO (Either () a)
runProjM env action = runErrorT $ runReaderT action env


getProjects :: Env -> [FilePath] -> IO [Either String Project]
getProjects env dirs = sequence . map (getProjectInfo env) $ dirs


getProjectInfo :: Env -> FilePath -> IO (Either String Project)
getProjectInfo env dir = do
   r <- runProjM env $ do
      darcsRepoDir' <- asks darcsRepoDir
      let path = darcsRepoDir' </> dir </> "README.md"

      exists <- liftIO $ doesFileExist path
      unless exists $ throwError ()

      contents <- liftIO $ readFile path
      let mdesc = matchRegex (mkRegexWithOpts
            ".*## synopsis(.*)## description" False False)
            contents

      page <- (\p -> printf p dir) <$> asks pageUrlPattern
      source <- (\p -> printf p dir) <$> asks srcUrlPattern

      maybe
         (throwError ())
         (\s -> return $ Project dir (clean s) page source)
         mdesc

   let errMsg = printf "%s/%s: NO PROJECT INFO FOUND"
         (darcsRepoDir env) dir
   either (return . const (Left errMsg)) (return . Right) r

   where
      clean = unwords . words . head