{-# 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
       { 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 (Text -> Text
unhide (Text -> Text) -> (FilePath -> Text) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
takeFileName (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


unhide :: Text -> Text
unhide :: Text -> Text
unhide = (Char -> Bool) -> Text -> Text
T.dropWhile (Char
'.' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==)


targetBaseName :: FilePath
targetBaseName :: FilePath
targetBaseName = FilePath
"parochial"


defaultPath :: Target
defaultPath :: FilePath
defaultPath = FilePath
"/srv" FilePath -> ShowS
</> FilePath
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 FilePath -> IO FilePath
defaultTarget = IO FilePath
-> (FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO FilePath
bestTarget FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure


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 = FilePath -> ShowS
(</>) (FilePath -> ShowS) -> IO FilePath -> IO ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath -> IO FilePath
defaultTarget Maybe FilePath
t IO ShowS -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Applicative f => 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'


-- | Take the value from either the --state option or 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"


-- | 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. <general heavy sigh>
bestTarget :: IO Target
bestTarget :: IO FilePath
bestTarget = IO Bool
doesDefaultTargetExist IO Bool -> (Bool -> IO FilePath) -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO FilePath -> Bool -> IO FilePath
forall (f :: * -> *).
Applicative f =>
f FilePath -> Bool -> f FilePath
boolWithDef (IO Bool
isParentWritable IO Bool -> (Bool -> IO FilePath) -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=  IO FilePath -> Bool -> IO FilePath
forall (f :: * -> *).
Applicative f =>
f FilePath -> Bool -> f FilePath
boolWithDef IO FilePath
homeTarget)
  where
    doesDefaultTargetExist :: IO Bool
doesDefaultTargetExist = FilePath -> IO Bool
doesDirectoryExist FilePath
defaultPath
    isParentWritable :: IO Bool
isParentWritable = Permissions -> Bool
writable (Permissions -> Bool) -> IO Permissions -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Permissions
getPermissions (ShowS
takeDirectory FilePath
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 :: f FilePath -> Bool -> f FilePath
boolWithDef = (f FilePath -> f FilePath -> Bool -> f FilePath)
-> f FilePath -> f FilePath -> Bool -> f FilePath
forall a b c. (a -> b -> c) -> b -> a -> c
flip f FilePath -> f FilePath -> Bool -> f FilePath
forall a. a -> a -> Bool -> a
bool (FilePath -> f FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
defaultPath)


homeTarget :: IO Target
homeTarget :: IO FilePath
homeTarget = XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
XdgData FilePath
targetBaseName