{-# LANGUAGE AllowAmbiguousTypes     #-}
{-# LANGUAGE MultiParamTypeClasses   #-}
{-# LANGUAGE UndecidableInstances    #-}
{-# LANGUAGE UndecidableSuperClasses #-}

module CLI.Orchestrator.Deriver
    ( gCLI
    ) where

import Control.Applicative (Applicative (liftA2), (<**>))
import Data.Kind           (Type)
import Data.Typeable       (Proxy (Proxy))

import Generics.SOP            (All, ConstructorInfo (Record), Generic (Code, to), HasDatatypeInfo (datatypeInfo),
                                Injection, IsProductType, K (K), SOP (SOP), constructorInfo, constructorName,
                                datatypeName, fieldName, hcmap, hmap, hsequence, injections, productTypeTo,
                                type (-.->) (Fn), unK)
import Generics.SOP.Constraint (And)
import Generics.SOP.NP         (NP (Nil, (:*)), collapse_NP, czipWith_NP, hd, map_NP)
import Options.Applicative     (CommandFields, Mod, Parser, ParserInfo, command, fullDesc, header, help, helper,
                                hsubparser, info, long, metavar, option, progDesc, short, strOption)

import CLI.Orchestrator.IsArg (IsArg (argReader))
import CLI.Orchestrator.Utils (rangeNP)

typeNameOf :: forall x. HasDatatypeInfo x => String
typeNameOf = datatypeName . datatypeInfo $ Proxy @x

fieldNames :: forall a flds. (HasDatatypeInfo a, IsProductType a flds) => NP (K String) flds
fieldNames = case hd . constructorInfo . datatypeInfo $ Proxy @a of
  Record _ np -> hmap (K . fieldName) np
  -- This branch uses stuff like `--0`, `--1` and so on for argument names.
  _           -> hmap (K . show . unK) $ rangeNP @flds

constructorNames :: (Generic a, HasDatatypeInfo a) => Proxy a -> NP (K String) (Code a)
constructorNames p =
  map_NP (K . constructorName) (constructorInfo (datatypeInfo p))

-- | Parser for each command. This is derived for each of the field types in each of the constructors in `AllParams`.
gcommand :: forall a flds. (HasDatatypeInfo a, IsProductType a flds, All (And HasDatatypeInfo IsArg) flds) => Parser a
gcommand = fmap productTypeTo
  . hsequence
  . hcmap (Proxy @(And HasDatatypeInfo IsArg)) f
  $ fieldNames @a
  where
    f :: forall x. And HasDatatypeInfo IsArg x => K String x -> Parser x
    f (K fldName) = option argReader $ long fldName <> metavar (typeNameOf @x)

-- Credit: @kosmikus; https://gist.github.com/kosmikus/58a374cf8594600e583c088d005ee330
-- Thanks!
class IsCommandCode (xs :: [Type]) where
  gsubparser :: Generic a => Injection (NP Parser) (Code a) xs -> Parser a

instance
  ( IsProductType a xs
  , HasDatatypeInfo a
  , All HasDatatypeInfo xs
  , All (And HasDatatypeInfo IsArg) xs
  )
  => IsCommandCode '[a]
  where
  gsubparser (Fn inj) = to <$> hsequence (SOP (unK (inj (gcommand @a :* Nil))))

gsubparsers ::
  forall a .
  (Generic a, HasDatatypeInfo a, All IsCommandCode (Code a))
  => Parser a
gsubparsers =
  hsubparser
  . mconcat
  . collapse_NP
  . czipWith_NP
    (Proxy @IsCommandCode)
      f
      (injections @_ @(NP Parser))
      $ constructorNames (Proxy @a)
  where
    f :: IsCommandCode xs => Injection (NP Parser) (Code a) xs -> K String xs -> K (Mod CommandFields a) xs
    f conInj (K constrName) =
      K
      . command constrName
      . info (gsubparser conInj)
      $ fullDesc <> progDesc ("Using " <> constrName <> " with given parameters")

{- | Dynamic compilation CLI built based on overarching argument ADT.

=== Example ===

@

data AllParams = FirstThing FirstParams | SecondThing SecondParams
  deriving stock (GHC.Generic, Show)
  deriving anyclass (Generic, HasDatatypeInfo)

data FirstParams = MkFirstParams {fooOne :: String}
  deriving stock (GHC.Generic, Show)
  deriving anyclass (Generic, HasDatatypeInfo)

data SecondParams = MkSecondParams {fooTwo :: Bool, fooThree :: ()}
  deriving stock (GHC.Generic, Show)
  deriving anyclass (Generic, HasDatatypeInfo)

cliP :: ParserInfo (AllParams, FilePath)
cliP = gCLI @AllParams "Description" "CLI header"

@

cliP will make a CLI that has 2 subcommands- "FirstThing" and "SecondThing".
"FirstThing" command takes one argument "fooOne".
"SecondThing" command takes two arguments "fooTwo" & "fooThree".

Regardless of the chosen subcommand, there's also an output path argument (`-o`).

In general, there should be one overarching ADT (e.g `AllParams`), with one or more
constructors indicating subcommands. Each constructor must have exactly one field designating another
product type, which describes the arguments for the command.
-}
gCLI ::
  forall a.
  ( HasDatatypeInfo a
  , All IsCommandCode (Code a)
  ) =>
  String ->
  String ->
  ParserInfo (a, FilePath)
gCLI cliHeader descr =
  info
    (optP <**> helper)
    $ header cliHeader <> progDesc descr <> fullDesc
  where
    optP = liftA2 (,) commandsP outputPathP
    commandsP = gsubparsers @a
    outputPathP =
      strOption $ short 'o' <> metavar "Path" <> help "Output path"