{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

module Text.LambdaOptions.Internal.OpaqueParser (
    OpaqueParser,
    GetOpaqueParsers,
    getOpaqueParsers,
) where


import Data.Proxy
import Data.Typeable
import Text.LambdaOptions.Internal.Opaque
import Text.LambdaOptions.Parseable
import Type.Funspection


--------------------------------------------------------------------------------


type OpaqueParser = [String] -> (Maybe Opaque, Int)


parseOpaque :: forall a. (Parseable a, Typeable a) => Proxy a -> OpaqueParser
parseOpaque ~Proxy str = case parse str of
    (Nothing, n) -> (Nothing, n)
    (Just (x::a), n) -> (Just $ Opaque x, n)


--------------------------------------------------------------------------------


class GetOpaqueParsers' r f where
    getOpaqueParsers' :: Proxy r -> Proxy f -> [(TypeRep, OpaqueParser)]


instance (Parseable a, Typeable a, GetOpaqueParsers' r b) => GetOpaqueParsers' r (a -> b) where
    getOpaqueParsers' proxyR ~Proxy = let
        proxyA = Proxy :: Proxy a
        proxyB = Proxy :: Proxy b
        rep = typeRep proxyA
        parser = parseOpaque proxyA
        in (rep, parser) : getOpaqueParsers' proxyR proxyB


instance GetOpaqueParsers' r (Return r) where
    getOpaqueParsers' ~Proxy ~Proxy = []


--------------------------------------------------------------------------------


type GetOpaqueParsers r f = GetOpaqueParsers' r (TaggedReturn r f)


getOpaqueParsers :: forall r f. (GetOpaqueParsers r f) => Proxy r -> Proxy f -> [(TypeRep, OpaqueParser)]
getOpaqueParsers proxyR ~Proxy = getOpaqueParsers' proxyR (Proxy :: Proxy (TaggedReturn r f))