{-# 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
       { Config w -> w ::: (Maybe FilePath <?> "Target directory")
target    :: w ::: Maybe FilePath  <?> "Target directory"
       , Config w
-> w
   ::: (Maybe Text
        <?> "The name of the project. Default to project name derived from $CWD")
project   :: w ::: Maybe Text      <?> "The name of the project. Default to project name derived from $CWD"
       , Config w -> w ::: (Maybe FilePath <?> "The state file")
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 ((forall x. Config w -> Rep (Config w) x)
-> (forall x. Rep (Config w) x -> Config w) -> Generic (Config w)
forall x. Rep (Config w) x -> Config w
forall x. Config w -> Rep (Config w) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall w x. Rep (Config w) x -> Config w
forall w x. Config w -> Rep (Config w) x
$cto :: forall w x. Rep (Config w) x -> Config w
$cfrom :: forall w x. Config w -> Rep (Config w) x
Generic)


instance ParseRecord (Config Wrapped)
deriving instance Show (Config Unwrapped)


setupConfigFile :: FilePath
setupConfigFile :: FilePath
setupConfigFile = FilePath
"setup-config"


defaultDistDir :: FilePath
defaultDistDir :: FilePath
defaultDistDir = FilePath
"dist-newstyle"

getCurrentProject :: Maybe Text -> IO Text
getCurrentProject :: Maybe Text -> IO Text
getCurrentProject = IO Text -> (Text -> IO Text) -> Maybe Text -> IO Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> Text
forall a b. ConvertText a b => a -> b
toS (FilePath -> Text) -> ShowS -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeBaseName (FilePath -> Text) -> IO FilePath -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getCurrentDirectory) Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure


-- This is me being laxy.
-- FIXME put this in  home somewhere.
defaultTarget :: Maybe FilePath -> Target
defaultTarget :: Maybe FilePath -> FilePath
defaultTarget = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"/srv/parochial"


getAndMkTargetPath :: Maybe Text -> Maybe FilePath -> IO Target
getAndMkTargetPath :: Maybe Text -> Maybe FilePath -> IO FilePath
getAndMkTargetPath Maybe Text
p Maybe FilePath
t = IO FilePath
getTarget IO FilePath -> (FilePath -> IO FilePath) -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO FilePath
mkTargetPath
  where
    getTarget :: IO FilePath
getTarget = (Maybe FilePath -> FilePath
defaultTarget Maybe FilePath
t FilePath -> ShowS
</>) ShowS -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> FilePath
forall a b. ConvertText a b => a -> b
toS (Text -> FilePath) -> IO Text -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> IO Text
getCurrentProject Maybe Text
p)
    mkTargetPath :: FilePath -> IO FilePath
mkTargetPath FilePath
p' = Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
p' IO () -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
p'


-- | Takes the value from either the --state option or tries to find the setup-config
--   itself.
getState :: Maybe FilePath -> IO FilePath
getState :: Maybe FilePath -> IO FilePath
getState = IO FilePath
-> (FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO FilePath
findSetupConfig FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
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 :: IO FilePath
findSetupConfig = do
  FilePath
d <- IO FilePath
dist
  FilePath -> IO (Maybe FilePath)
findS FilePath
d IO (Maybe FilePath)
-> (Maybe FilePath -> IO FilePath) -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO FilePath
-> (FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> IO FilePath
forall a. FilePath -> IO a
dieNoVerbosity (FilePath
"Can't find: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
setupConfigFile)) (FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> IO FilePath) -> ShowS -> FilePath -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
d FilePath -> ShowS
</>))

  where
    dist :: IO FilePath
    dist :: IO FilePath
dist = FilePath -> Flag FilePath -> IO FilePath
findDistPref FilePath
"." (FilePath -> Flag FilePath
forall a. a -> Flag a
Flag FilePath
defaultDistDir)

    findS :: FilePath -> IO (Maybe FilePath)
    findS :: FilePath -> IO (Maybe FilePath)
findS FilePath
d = [FilePath] -> Maybe FilePath
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
head ([FilePath] -> Maybe FilePath)
-> IO [FilePath] -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [FilePath] -> IO [FilePath]
getDirectoryFiles FilePath
d [FilePath
"**/x/**" FilePath -> ShowS
</> FilePath
setupConfigFile]


parseCmdOptions :: MonadIO m => m (Config Unwrapped)
parseCmdOptions :: m (Config Unwrapped)
parseCmdOptions = Text -> m (Config Unwrapped)
forall (io :: * -> *) (f :: * -> *).
(Functor io, MonadIO io, ParseRecord (f Wrapped), Unwrappable f) =>
Text -> io (f Unwrapped)
unwrapRecord Text
"Generate project specific haddocks"