{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeOperators #-} module Parochial.Options ( Config(..) , getAndMkTargetPath , getState , parseCmdOptions ) where import Protolude hiding (state) import qualified Data.Text as T 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 (unhide . toS . takeFileName <$> getCurrentDirectory) pure unhide :: Text -> Text unhide = T.dropWhile ('.' ==) targetBaseName :: FilePath targetBaseName = "parochial" defaultPath :: Target defaultPath = "/srv" targetBaseName -- | What the target directory should be. This checks the --target option and if set uses -- is otherwise it uses @bestTarget@ to work out what to do. defaultTarget :: Maybe FilePath -> IO Target defaultTarget = maybe bestTarget pure 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' -- | Take the value from either the --state option or 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" -- | Check if defaultTarget exists and if not check that the parent directory is writable. -- If the parent directory is writable then create it otherwise use $HOME/.parochial. -- I'm not sure if this is the best place but I'm not sure where to put it! $HOME/.local/srv -- would be best but this isn't covered by any standard I know off and therefore really -- confusing to everyone else. bestTarget :: IO Target bestTarget = doesDefaultTargetExist >>= boolWithDef (isParentWritable >>= boolWithDef homeTarget) where doesDefaultTargetExist = doesDirectoryExist defaultPath isParentWritable = writable <$> getPermissions (takeDirectory defaultPath) -- | If the second argument is True then return the @defaultPath@ otherwise evaluate the -- second argument. boolWithDef :: Applicative f => f Target -> Bool -> f Target boolWithDef = flip bool (pure defaultPath) homeTarget :: IO Target homeTarget = getXdgDirectory XdgData targetBaseName