HKDOpts.hs

{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances, PolyKinds     #-}
{-# LANGUAGE RankNTypes, RecordWildCards, StandaloneDeriving, TypeFamilies #-}
{-# LANGUAGE UndecidableInstances                                          #-}
module Lib where
import Data.Functor.Identity
import Options.Applicative

someFunc :: IO ()
someFunc = putStrLn "someFunc"

data family Params' mode (m :: * -> *) (h :: * -> *)
type Params eqns m = Params' eqns m Identity

data A
data B

data instance Params' A m h =
  APar { a01 :: h Double
       , a02 :: h Int
       }
deriving instance (Show (h Double), Show (h Int)) => Show (Params' A m h)
deriving instance (Eq (h Double), Eq (h Int)) => Eq (Params' A m h)
deriving instance (Ord (h Double), Ord (h Int)) => Ord (Params' A m h)

class FFunctor f where
  ffmap :: (forall x. h x -> h' x) -> f h -> f h'

instance FFunctor (Params' A m) where
  ffmap h APar{..} = APar (h a01) (h a02)

class FFunctor f => FTraversable f where
  ftraverse
    :: Applicative t
    => (forall a. h a -> t (g a))
    -> f h -> t (f g)

instance FTraversable (Params' A m) where
  ftraverse f APar{..} =
    APar <$> f a01 <*> f a02

class FFunctor f => FZip f where
  fzipWith :: (forall x. h x -> g x -> k x) -> f h -> f g -> f k

instance FZip (Params' A m) where
  fzipWith f (APar ha hb) (APar ga gb) =
    APar (f ha ga) (f hb gb)

fsequence
  :: (FTraversable h, Applicative f)
  => h f -> f (h Identity)
fsequence = ftraverse (fmap Identity)

optionalise
  :: Params' A m Parser
  -> Parser (Params' A m Maybe)
optionalise  = ftraverse optional