module Options (Package(..), Options(..), def, Packages, options) where
import Prelude hiding (takeWhile, writeFile)

import Constants
import FlakeTemplate
import ShellifyTemplate

import Control.Applicative ((<|>))
import Control.Arrow ((+++))
import Control.Monad (when)
import Data.Bool (bool)
import Data.Default.Class (Default(def))
import Data.List (find, sort)
import Data.Maybe (fromMaybe)
import Data.Text (isInfixOf, isPrefixOf, pack, replace, splitOn, stripPrefix, takeWhile, Text(), unpack)
import Data.Text.IO (hPutStrLn, writeFile)
import Data.Version (showVersion)
import qualified Data.Text.IO as Text
import GHC.IO.Exception (ExitCode(ExitSuccess, ExitFailure))
import Paths_shellify (version)
import System.Directory (doesPathExist)
import System.Exit (exitWith)
import System.IO (stderr)
import Text.StringTemplate (newSTMP, render, setAttribute, StringTemplate)

type Package = Text
type Packages = [ Package ]
data Options = Options {
    Options -> Packages
packages :: Packages
  , Options -> Maybe Text
command :: Maybe Text
  , Options -> Bool
generateFlake :: Bool
}

data OptionsParser = OptionsParser [Text] -- remainingOptions
                                   (Either Text (Options -> Options)) -- result

options :: Text -> [Text] -> Either Text Options
options :: Text -> Packages -> Either Text Options
options Text
progName Packages
args =
  let optionsHandler :: Text -> Packages -> OptionsParser
optionsHandler | Packages -> Bool
hasShellArg Packages
args = Text -> Packages -> OptionsParser
newStyleOption
                     | Bool
otherwise = Text -> Packages -> OptionsParser
oldStyleOption
      shellArgFilter :: Packages -> Packages
shellArgFilter | Packages -> Bool
hasShellArg Packages
args = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Text
"shell")
                     | Bool
otherwise = forall a. a -> a
id
      optionsCaller :: (Text -> Packages -> OptionsParser)
-> OptionsParser -> Either Text (Options -> Options)
optionsCaller Text -> Packages -> OptionsParser
f = OptionsParser -> Either Text (Options -> Options)
worker 
       where worker :: OptionsParser -> Either Text (Options -> Options)
worker (OptionsParser [] Either Text (Options -> Options)
t) = Either Text (Options -> Options)
t
             worker (OptionsParser (Text
hd:Packages
tl) Either Text (Options -> Options)
res) =
               let (OptionsParser Packages
newRemaining Either Text (Options -> Options)
newRes) = Text -> Packages -> OptionsParser
f Text
hd Packages
tl
               in OptionsParser -> Either Text (Options -> Options)
worker forall a b. (a -> b) -> a -> b
$ Packages -> Either Text (Options -> Options) -> OptionsParser
OptionsParser Packages
newRemaining (forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text (Options -> Options)
newRes forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either Text (Options -> Options)
res)

      screenForNoPackages :: Either Text Options -> Either Text Options
screenForNoPackages (Right Options
opts) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Options -> Packages
packages Options
opts) = forall a b. a -> Either a b
Left Text
noPackagesError
      screenForNoPackages Either Text Options
anyThingElse = Either Text Options
anyThingElse
      initialArgumentsToParse :: Packages
initialArgumentsToParse = Packages -> Packages
shellArgFilter Packages
args
      initialModifier :: Either a (Options -> Options)
initialModifier = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ if Packages -> Bool
hasShellArg Packages
args then Options -> Options
setFlakeGeneration else forall a. a -> a
id
      initialOptionParser :: OptionsParser
initialOptionParser = Packages -> Either Text (Options -> Options) -> OptionsParser
OptionsParser Packages
initialArgumentsToParse forall {a}. Either a (Options -> Options)
initialModifier
  in Either Text Options -> Either Text Options
screenForNoPackages forall a b. (a -> b) -> a -> b
$ (forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Packages -> OptionsParser)
-> OptionsParser -> Either Text (Options -> Options)
optionsCaller Text -> Packages -> OptionsParser
optionsHandler OptionsParser
initialOptionParser

  where oldStyleOption :: Text -> [Text] -> OptionsParser
        oldStyleOption :: Text -> Packages -> OptionsParser
oldStyleOption Text
"-p" = Packages -> OptionsParser
handlePackageSwitch
        oldStyleOption Text
"--packages" = Packages -> OptionsParser
handlePackageSwitch
        oldStyleOption Text
opt = Text -> Packages -> OptionsParser
baseOption Text
opt
        newStyleOption :: Text -> Packages -> OptionsParser
newStyleOption Text
"-p" = Text -> Packages -> OptionsParser
returnError Text
"-p not supported with new style commands"
        newStyleOption Text
"--packages" = Text -> Packages -> OptionsParser
returnError Text
"--packages not supported with new style commands"
        newStyleOption Text
arg | Text -> Bool
isSwitch Text
arg = Text -> Packages -> OptionsParser
baseOption Text
arg
                           | Bool
otherwise = (Options -> Options) -> Packages -> OptionsParser
transformOptionsWith forall a b. (a -> b) -> a -> b
$ Packages -> Options -> Options
appendPackages [Text
arg]
        baseOption :: Text -> [Text] -> OptionsParser
        baseOption :: Text -> Packages -> OptionsParser
baseOption Text
"-h" = Text -> Packages -> OptionsParser
returnError forall a b. (a -> b) -> a -> b
$ Text -> Text
helpText Text
progName
        baseOption Text
"--help" = Text -> Packages -> OptionsParser
returnError forall a b. (a -> b) -> a -> b
$ Text -> Text
helpText Text
progName
        baseOption Text
"--version" = Text -> Packages -> OptionsParser
returnError forall a b. (a -> b) -> a -> b
$ Text
"Shellify " forall a. Semigroup a => a -> a -> a
<> (String -> Text
pack forall a b. (a -> b) -> a -> b
$ Version -> String
showVersion Version
version)
        baseOption Text
"--command" = Packages -> OptionsParser
handleCommandSwitch
        baseOption Text
"--run" = Packages -> OptionsParser
handleCommandSwitch
        baseOption Text
"--with-flake" = (Options -> Options) -> Packages -> OptionsParser
transformOptionsWith Options -> Options
setFlakeGeneration
        baseOption Text
_ = (Options -> Options) -> Packages -> OptionsParser
transformOptionsWith forall a. a -> a
id
        --doNothing = transformOptionsWith id
        transformOptionsWith :: (Options -> Options) -> Packages -> OptionsParser
transformOptionsWith Options -> Options
fun Packages
wds = Packages -> Either Text (Options -> Options) -> OptionsParser
OptionsParser Packages
wds (forall a b. b -> Either a b
Right Options -> Options
fun)
        handlePackageSwitch :: Packages -> OptionsParser
handlePackageSwitch Packages
wds = let (Packages
pkgs, Packages
remainingOptions) = Packages -> (Packages, Packages)
consumePackageArgs Packages
wds
                                  in (Options -> Options) -> Packages -> OptionsParser
transformOptionsWith (Packages -> Options -> Options
appendPackages Packages
pkgs) Packages
remainingOptions
        handleCommandSwitch :: Packages -> OptionsParser
handleCommandSwitch (Text
hd:Packages
tl) | Text -> Bool
isSwitch Text
hd
                                    = Text -> Packages -> OptionsParser
returnError Text
"Argument missing to switch" Packages
tl
                                    | Bool
otherwise
                                    = (Options -> Options) -> Packages -> OptionsParser
transformOptionsWith (Text -> Options -> Options
setCommand Text
hd) Packages
tl
        handleCommandSwitch [] = Text -> Packages -> OptionsParser
returnError Text
"Argument missing to switch" []

        appendPackages :: Packages -> Options -> Options
appendPackages Packages
ps Options
opts = Options
opts{packages :: Packages
packages=Packages
ps forall a. [a] -> [a] -> [a]
++ Options -> Packages
packages Options
opts}
        setCommand :: Text -> Options -> Options
setCommand Text
cmd Options
opts = Options
opts{command :: Maybe Text
command=forall a. a -> Maybe a
Just Text
cmd}
        setFlakeGeneration :: Options -> Options
setFlakeGeneration Options
opts = Options
opts{generateFlake :: Bool
generateFlake=Bool
True}
        returnError :: Text -> Packages -> OptionsParser
returnError Text
errorText Packages
remaining = Packages -> Either Text (Options -> Options) -> OptionsParser
OptionsParser Packages
remaining forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Text
errorText

consumePackageArgs :: [Text] -> (Packages, [Text])
consumePackageArgs :: Packages -> (Packages, Packages)
consumePackageArgs = Packages -> Packages -> (Packages, Packages)
worker []
  where worker :: Packages -> Packages -> (Packages, Packages)
worker Packages
pkgs [] = (Packages
pkgs, [])
        worker Packages
pkgs options :: Packages
options@(Text
hd:Packages
_) | Text -> Bool
isSwitch Text
hd
                                   = (Packages
pkgs, Packages
options)
        worker Packages
pkgs (Text
hd:Packages
tl) = Packages -> Packages -> (Packages, Packages)
worker (Text
hdforall a. a -> [a] -> [a]
:Packages
pkgs) Packages
tl

hasShellArg :: Packages -> Bool
hasShellArg [] = Bool
False
hasShellArg (Text
"shell":Packages
_) = Bool
True
hasShellArg (Text
hd:Packages
tl) | Text -> Bool
isSwitch Text
hd = Packages -> Bool
hasShellArg Packages
tl
                    | Bool
otherwise = Bool
False

isSwitch :: Text -> Bool
isSwitch = Text -> Text -> Bool
isPrefixOf Text
"-"

instance Default Options where
  def :: Options
def = Packages -> Maybe Text -> Bool -> Options
Options [] forall a. Maybe a
Nothing Bool
False

instance Eq Options where
  Options
a == :: Options -> Options -> Bool
== Options
b =  forall {a}. Eq a => (Options -> a) -> Bool
isEqual Options -> Maybe Text
command
         Bool -> Bool -> Bool
&& forall {a}. Eq a => (Options -> a) -> Bool
isEqual (forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Packages
packages)
         Bool -> Bool -> Bool
&& forall {a}. Eq a => (Options -> a) -> Bool
isEqual Options -> Bool
generateFlake
    where isEqual :: (Options -> a) -> Bool
isEqual Options -> a
f = Options -> a
f Options
a forall a. Eq a => a -> a -> Bool
== Options -> a
f Options
b