optparse-generic attempt

Generic.hs

{-# LANGUAGE DeriveGeneric, ScopedTypeVariables, RankNTypes, InstanceSigs, DefaultSignatures, FlexibleContexts, TypeOperators, FlexibleInstances #-}

import Control.Applicative
import GHC.Generics
import Options.Applicative hiding (argument)
import Data.Monoid

newtype ExampleArg = ExampleArg Int
  deriving Generic

data MyOptions = Foo Int Int | Bar | Baz deriving (Generic, Read, Show)

instance Argument Int
instance Argument MyOptions

main = print =<< execParser (info (argument :: Parser MyOptions) mempty)



class Argument a where
  argument :: Parser a
  default argument ::  (Generic a, GArgument (Rep a)) => Parser a
  argument = fmap to gargument

class GArgument f where
  gargument :: Parser (f a)

instance GArgument V1 where
  gargument = undefined

instance GArgument U1 where
  gargument = pure U1

instance (GArgument x, GArgument y) => GArgument (x :+: y) where
  gargument =   L1 <$> gargument
            <|> R1 <$> gargument

instance (GArgument x, GArgument y) => GArgument (x :*: y) where
  gargument = (:*:) <$> gargument <*> gargument

instance Argument x => GArgument (K1 i x) where
  gargument = K1 <$> argument

instance (GArgument f, Selector c) => GArgument (M1 S c f) where
  gargument = error "s1"

instance (GArgument f, Datatype c) => GArgument (M1 D c f) where
  gargument = M1 <$> gargument

instance (GArgument f, Constructor c) => GArgument (M1 C c f) where
  gargument = let name = conName (undefined :: M1 C c f a)
              in  M1 <$> subparser (command name (info gargument mempty))