content: {-# LANGUAGE TemplateHaskell, GADTs, FlexibleInstances #-}
  
  -- |
  -- Module      : Language.C.Inline.Hint
  -- Copyright   : [2013..2014] Manuel M T Chakravarty
  -- License     : BSD3
  --
  -- Maintainer  : Manuel M T Chakravarty <chak@justtesting.org>
  -- Stability   : experimental
  -- Portability : non-portable (GHC extensions)
  --
  -- This module provides the definition of marshalling hints.
  
  module Language.C.Inline.Hint (
    -- * Annotations
    Annotated(..), (<:), void, annotatedShowQ,
  
    -- * Hints
    Hint(..),
  
    -- * Querying of annotated entities
    haskellTypeOf, foreignTypeOf, stripAnnotation
  ) where
  
    -- common libraries
  import Control.Applicative
  import Language.Haskell.TH        as TH
  
    -- quasi-quotation libraries
  import Language.C.Quote           as QC
  
    -- friends
  import Language.C.Inline.Error
  
  
  -- |Annotating entities with hints.
  --
  -- The alternatives are to provide an explicit marshalling hint with '(:>)', or to leave the marshalling
  -- implicitly defined by the name's type.
  --
  data Annotated e where
    (:>)  :: Hint hint => e    -> hint -> Annotated e         -- explicit marshalling hint
    Typed ::              Name         -> Annotated Name      -- marshalling implicitly defined by name's type
  
  -- |We provide additional syntax where the hint is to the left of the annotated entity.
  --
  (<:) :: Hint hint => hint -> e -> Annotated e
  (<:) = flip (:>)
  
  -- |Annotation for irrelevant results
  --
  void :: e -> Annotated e
  void = (''() <:)
  
  -- |Pretty print an annotated entity.
  --
  annotatedShowQ :: Show e => Annotated e -> Q String
  annotatedShowQ (e :> hint)  = ((show e ++ " :> ") ++) <$> showQ hint
  annotatedShowQ (Typed name) = return $ "Typed " ++ show name
  
  -- |Hints imply marshalling strategies, which include source and destination types for marshalling.
  --
  class Hint hint where
    haskellType :: hint -> Q TH.Type
    foreignType :: hint -> Q (Maybe QC.Type)    -- ^In case of 'Nothing', the foreign type is determined by the Haskell type.
    showQ       :: hint -> Q String
  
  instance Hint Name where   -- must be a type name
    haskellType = conT
    foreignType = const (return Nothing)
    showQ       = return . show
  
  instance Hint (Q TH.Type) where
    haskellType = id
    foreignType = const (return Nothing)
    showQ       = (show <$>)
  
  -- |Determine the Haskell type implied for the given annotated entity.
  --
  haskellTypeOf :: Annotated e -> Q TH.Type
  haskellTypeOf (_ :> hint)  = haskellType hint
  haskellTypeOf (Typed name)
    = do
      { info <- reify name
      ; case info of
          ClassOpI _ ty _ _ -> return ty
          VarI     _ ty _ _ -> return ty
          nonVarInfo    ->
            do
            { reportErrorAndFail QC.C11 $
                "expected '" ++ show name ++ "' to be a typed variable name, but it is " ++
                show (TH.ppr nonVarInfo)
            }
      }
  
  -- |Determine the foreign type *directly* implied for the given annotated entity if any.
  --
  foreignTypeOf :: Annotated e -> Q (Maybe QC.Type)
  foreignTypeOf (_ :> hint)  = foreignType hint
  foreignTypeOf (Typed _) = return Nothing
  
  -- |Remove the annotation.
  --
  stripAnnotation :: Annotated e -> e
  stripAnnotation (e :> _)  = e
  stripAnnotation (Typed name) = name
  