Options.hs

{-# 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"