{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE QuasiQuotes            #-}
{-# LANGUAGE StandaloneDeriving     #-}
{-# LANGUAGE TemplateHaskell        #-}

module Config
  ( Config(..)
  , configParserInfo
  , checkConfig
  ) where

import           Data.Functor.Identity (Identity(..))
import           Data.Version (showVersion)
import           Options.Applicative
import qualified Paths_nix_freeze_tree as NixFreezeTree
import           Text.RawString.QQ (r)

data Config f = Config
  { Config f -> f Bool
_force :: f Bool
  , Config f -> f Bool
_verbose :: f Bool
  , Config f -> f FilePath
_outputRoot :: f FilePath
  , Config f -> f FilePath
_inDir :: f FilePath
  }

deriving instance Eq (Config Identity)
deriving instance Eq (Config Maybe)
deriving instance Show (Config Identity)
deriving instance Show (Config Maybe)

version :: Parser (a -> a)
version :: Parser (a -> a)
version = ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a.
ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
abortOption (FilePath -> ParseError
InfoMsg FilePath
message) (Mod OptionFields (a -> a) -> Parser (a -> a))
-> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields (a -> a)] -> Mod OptionFields (a -> a)
forall a. Monoid a => [a] -> a
mconcat
  [ FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"version"
  , FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Display version information and exit."
  ]
  where
    message :: FilePath
message = FilePath
"nix-freeze-tree " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Version -> FilePath
showVersion Version
NixFreezeTree.version FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"\n"
      FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r|Copyright (C) 2020 Jack Kelly

License AGPLv3+: GNU Affero General Public License version 3 or later
  <https://www.gnu.org/licenses/agpl-3.0.html>

This is free software: you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law.
|]

configParser :: Parser (Config Maybe)
configParser :: Parser (Config Maybe)
configParser = Maybe Bool
-> Maybe Bool -> Maybe FilePath -> Maybe FilePath -> Config Maybe
forall (f :: * -> *).
f Bool -> f Bool -> f FilePath -> f FilePath -> Config f
Config
  (Maybe Bool
 -> Maybe Bool -> Maybe FilePath -> Maybe FilePath -> Config Maybe)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool -> Maybe FilePath -> Maybe FilePath -> Config Maybe)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do (Bool -> Maybe Bool) -> Parser Bool -> Parser (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Parser Bool -> Parser (Maybe Bool))
-> (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool
-> Parser (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser (Maybe Bool))
-> Mod FlagFields Bool -> Parser (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Bool] -> Mod FlagFields Bool
forall a. Monoid a => [a] -> a
mconcat
           [ FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"force"
           , Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f'
           , FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help
             (FilePath -> Mod FlagFields Bool)
-> FilePath -> Mod FlagFields Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"If any default.nix exist in the output directory, "
             FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"remove them and generate anyway"
           ]
  Parser
  (Maybe Bool -> Maybe FilePath -> Maybe FilePath -> Config Maybe)
-> Parser (Maybe Bool)
-> Parser (Maybe FilePath -> Maybe FilePath -> Config Maybe)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> do (Bool -> Maybe Bool) -> Parser Bool -> Parser (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Parser Bool -> Parser (Maybe Bool))
-> (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool
-> Parser (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser (Maybe Bool))
-> Mod FlagFields Bool -> Parser (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Bool] -> Mod FlagFields Bool
forall a. Monoid a => [a] -> a
mconcat
           [ FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"verbose"
           , Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v'
           , FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Display messages while working."
           ]
  Parser (Maybe FilePath -> Maybe FilePath -> Config Maybe)
-> Parser (Maybe FilePath)
-> Parser (Maybe FilePath -> Config Maybe)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> do ReadM (Maybe FilePath)
-> Mod OptionFields (Maybe FilePath) -> Parser (Maybe FilePath)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> ReadM FilePath -> ReadM (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM FilePath
forall s. IsString s => ReadM s
str) (Mod OptionFields (Maybe FilePath) -> Parser (Maybe FilePath))
-> Mod OptionFields (Maybe FilePath) -> Parser (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields (Maybe FilePath)]
-> Mod OptionFields (Maybe FilePath)
forall a. Monoid a => [a] -> a
mconcat
           [ FilePath -> Mod OptionFields (Maybe FilePath)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"out-root"
           , Char -> Mod OptionFields (Maybe FilePath)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'o'
           , FilePath -> Mod OptionFields (Maybe FilePath)
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"OUT_ROOT"
           , FilePath -> Mod OptionFields (Maybe FilePath)
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Where to write the nix files"
           , (Maybe FilePath -> FilePath) -> Mod OptionFields (Maybe FilePath)
forall a (f :: * -> *). (a -> FilePath) -> Mod f a
showDefaultWith ((Maybe FilePath -> FilePath) -> Mod OptionFields (Maybe FilePath))
-> (Maybe FilePath -> FilePath)
-> Mod OptionFields (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath -> FilePath
forall a b. a -> b -> a
const FilePath
"IN_DIR"
           , Maybe FilePath -> Mod OptionFields (Maybe FilePath)
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Maybe FilePath
forall a. Maybe a
Nothing
           ]
  Parser (Maybe FilePath -> Config Maybe)
-> Parser (Maybe FilePath) -> Parser (Config Maybe)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> do ReadM (Maybe FilePath)
-> Mod ArgumentFields (Maybe FilePath) -> Parser (Maybe FilePath)
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> ReadM FilePath -> ReadM (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM FilePath
forall s. IsString s => ReadM s
str) (Mod ArgumentFields (Maybe FilePath) -> Parser (Maybe FilePath))
-> Mod ArgumentFields (Maybe FilePath) -> Parser (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ [Mod ArgumentFields (Maybe FilePath)]
-> Mod ArgumentFields (Maybe FilePath)
forall a. Monoid a => [a] -> a
mconcat
           [ FilePath -> Mod ArgumentFields (Maybe FilePath)
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"IN_DIR"
           , FilePath -> Mod ArgumentFields (Maybe FilePath)
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Directory to freeze"
           , (Maybe FilePath -> FilePath) -> Mod ArgumentFields (Maybe FilePath)
forall a (f :: * -> *). (a -> FilePath) -> Mod f a
showDefaultWith ((Maybe FilePath -> FilePath)
 -> Mod ArgumentFields (Maybe FilePath))
-> (Maybe FilePath -> FilePath)
-> Mod ArgumentFields (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath -> FilePath
forall a b. a -> b -> a
const FilePath
"."
           , Maybe FilePath -> Mod ArgumentFields (Maybe FilePath)
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
".")
           ]

configParserInfo :: ParserInfo (Config Maybe)
configParserInfo :: ParserInfo (Config Maybe)
configParserInfo = Parser (Config Maybe)
-> InfoMod (Config Maybe) -> ParserInfo (Config Maybe)
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser
  ((Config Maybe -> Config Maybe) -> Config Maybe -> Config Maybe)
forall a. Parser (a -> a)
version Parser
  ((Config Maybe -> Config Maybe) -> Config Maybe -> Config Maybe)
-> Parser (Config Maybe -> Config Maybe)
-> Parser (Config Maybe -> Config Maybe)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Config Maybe -> Config Maybe)
forall a. Parser (a -> a)
helper Parser (Config Maybe -> Config Maybe)
-> Parser (Config Maybe) -> Parser (Config Maybe)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Config Maybe)
configParser) (InfoMod (Config Maybe) -> ParserInfo (Config Maybe))
-> InfoMod (Config Maybe) -> ParserInfo (Config Maybe)
forall a b. (a -> b) -> a -> b
$ [InfoMod (Config Maybe)] -> InfoMod (Config Maybe)
forall a. Monoid a => [a] -> a
mconcat
  [ FilePath -> InfoMod (Config Maybe)
forall a. FilePath -> InfoMod a
header
    (FilePath -> InfoMod (Config Maybe))
-> FilePath -> InfoMod (Config Maybe)
forall a b. (a -> b) -> a -> b
$ FilePath
"nix-freeze-tree - "
    FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"Create fixed-output derivations for each file in a tree"
  , FilePath -> InfoMod (Config Maybe)
forall a. FilePath -> InfoMod a
progDesc
    (FilePath -> InfoMod (Config Maybe))
-> FilePath -> InfoMod (Config Maybe)
forall a b. (a -> b) -> a -> b
$ FilePath
"Write a tree of nix expressions to OUT_ROOT that build a "
    FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"derivation, symlinking every file in IN_DIR as a separate "
    FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"fixed-output derivation."
  , InfoMod (Config Maybe)
forall a. InfoMod a
fullDesc
  ]

checkConfig :: Config Maybe -> Maybe (Config Identity)
checkConfig :: Config Maybe -> Maybe (Config Identity)
checkConfig = Config Maybe -> Maybe (Config Identity)
forall (f :: * -> *).
Applicative f =>
Config f -> f (Config Identity)
collectMaybes (Config Maybe -> Maybe (Config Identity))
-> (Config Maybe -> Config Maybe)
-> Config Maybe
-> Maybe (Config Identity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config Maybe -> Config Maybe
applyDefaults
  where
    collectMaybes :: Config f -> f (Config Identity)
collectMaybes (Config f Bool
f f Bool
v f FilePath
o f FilePath
i) = Identity Bool
-> Identity Bool
-> Identity FilePath
-> Identity FilePath
-> Config Identity
forall (f :: * -> *).
f Bool -> f Bool -> f FilePath -> f FilePath -> Config f
Config
      (Identity Bool
 -> Identity Bool
 -> Identity FilePath
 -> Identity FilePath
 -> Config Identity)
-> f (Identity Bool)
-> f (Identity Bool
      -> Identity FilePath -> Identity FilePath -> Config Identity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> Identity Bool
forall a. a -> Identity a
Identity (Bool -> Identity Bool) -> f Bool -> f (Identity Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Bool
f)
      f (Identity Bool
   -> Identity FilePath -> Identity FilePath -> Config Identity)
-> f (Identity Bool)
-> f (Identity FilePath -> Identity FilePath -> Config Identity)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Identity Bool
forall a. a -> Identity a
Identity (Bool -> Identity Bool) -> f Bool -> f (Identity Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Bool
v)
      f (Identity FilePath -> Identity FilePath -> Config Identity)
-> f (Identity FilePath)
-> f (Identity FilePath -> Config Identity)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FilePath -> Identity FilePath
forall a. a -> Identity a
Identity (FilePath -> Identity FilePath)
-> f FilePath -> f (Identity FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f FilePath
o)
      f (Identity FilePath -> Config Identity)
-> f (Identity FilePath) -> f (Config Identity)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FilePath -> Identity FilePath
forall a. a -> Identity a
Identity (FilePath -> Identity FilePath)
-> f FilePath -> f (Identity FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f FilePath
i)

    applyDefaults :: Config Maybe -> Config Maybe
applyDefaults Config Maybe
c = Maybe Bool
-> Maybe Bool -> Maybe FilePath -> Maybe FilePath -> Config Maybe
forall (f :: * -> *).
f Bool -> f Bool -> f FilePath -> f FilePath -> Config f
Config
      (Config Maybe -> Maybe Bool
forall (f :: * -> *). Config f -> f Bool
_force Config Maybe
c)
      (Config Maybe -> Maybe Bool
forall (f :: * -> *). Config f -> f Bool
_verbose Config Maybe
c Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False)
      (Config Maybe -> Maybe FilePath
forall (f :: * -> *). Config f -> f FilePath
_outputRoot Config Maybe
c Maybe FilePath -> Maybe FilePath -> Maybe FilePath
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Config Maybe -> Maybe FilePath
forall (f :: * -> *). Config f -> f FilePath
_inDir Config Maybe
c)
      (Config Maybe -> Maybe FilePath
forall (f :: * -> *). Config f -> f FilePath
_inDir Config Maybe
c)