{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeOperators #-} module Parochial.Options ( Config(..) , getCurrentProject , defaultTarget , getAndMkTargetPath , getState , parseCmdOptions ) where import Protolude hiding (state) import Distribution.Simple.Flag import Distribution.Simple.Utils hiding (findFile) import Distribution.Simple.Configure import System.Directory import System.FilePath import System.FilePattern.Directory import Options.Generic import Parochial.Types data Config w = Haddock { target :: w ::: Maybe FilePath "Target directory" , project :: w ::: Maybe Text "The name of the project. Default to project name derived from $CWD" , state :: w ::: Maybe FilePath "The state file" } | Hoogle { target :: w ::: Maybe FilePath "Target directory" , project :: w ::: Maybe Text "The name of the project. Default to project name derived from $CWD" , state :: w ::: Maybe FilePath "The state file" } deriving (Generic) instance ParseRecord (Config Wrapped) deriving instance Show (Config Unwrapped) setupConfigFile :: FilePath setupConfigFile = "setup-config" defaultDistDir :: FilePath defaultDistDir = "dist-newstyle" getCurrentProject :: Maybe Text -> IO Text getCurrentProject = maybe (toS . takeBaseName <$> getCurrentDirectory) pure -- This is me being laxy. -- FIXME put this in home somewhere. defaultTarget :: Maybe FilePath -> Target defaultTarget = fromMaybe "/srv/parochial" getAndMkTargetPath :: Maybe Text -> Maybe FilePath -> IO Target getAndMkTargetPath p t = getTarget >>= mkTargetPath where getTarget = (defaultTarget t ) <$> (toS <$> getCurrentProject p) mkTargetPath p' = createDirectoryIfMissing True p' >> pure p' -- | Takes the value from either the --state option or tries to find the setup-config -- itself. getState :: Maybe FilePath -> IO FilePath getState = maybe findSetupConfig pure -- | Try and find the setup-config file. This is *very* primative at the moment and -- will simply search for the first path returned by **/x/**/setup-config findSetupConfig :: IO FilePath findSetupConfig = do d <- dist findS d >>= maybe (dieNoVerbosity ("Can't find: " <> setupConfigFile)) (pure . (d )) where dist :: IO FilePath dist = findDistPref "." (Flag defaultDistDir) findS :: FilePath -> IO (Maybe FilePath) findS d = head <$> getDirectoryFiles d ["**/x/**" setupConfigFile] parseCmdOptions :: MonadIO m => m (Config Unwrapped) parseCmdOptions = unwrapRecord "Generate project specific haddocks"