module Data.Packed.TH.Packable (genPackableInstance) where

import Data.Packed.Packable
import Data.Packed.TH.Flag (PackingFlag)
import Data.Packed.TH.Utils (resolveAppliedType)
import Data.Packed.TH.Write
import Language.Haskell.TH

-- | Generates an instance of 'Packable' for the given type
--
-- All the parameters of each constructor should be instances of 'Packable'
--
-- Note: The pack function simply calls the function generated by 'genWrite'
--
-- __Example__
--
-- For the 'Tree' data type, it generates the following instance:
--
-- @
-- instance ('Packable' a) => 'Packable' (Tree a) where
--     write = writeTree
-- @
genPackableInstance ::
    [PackingFlag] ->
    -- | The name of the type to generate the instance for
    Name ->
    Q [Dec]
genPackableInstance flags tyName = do
    (resolvedType, typeParameterNames) <- resolveAppliedType tyName
    constraints <- mapM (\t -> [t|Packable $(varT t)|]) typeParameterNames
    instanceType <- [t|Packable $(return resolvedType)|]
    writeFunc <- genWrite flags tyName
    toNeedsExpr <- varE $ writeFName tyName
    toNeedsMethod <- funD 'write [clause [] (normalB (return toNeedsExpr)) []]
    return $
        writeFunc
            ++ [ InstanceD
                    (Just Overlapping)
                    constraints
                    instanceType
                    [toNeedsMethod]
               ]