{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}

{-# OPTIONS -fglasgow-exts #-}

-- |Contains functions to automatically create instances from
-- data type definitions.
module Graphics.UI.SybWidget.InstanceCreator
    ( gGenUpTo
    , createInstance, createInstance'
    , instanceFromConstr
    )

where

import Graphics.UI.SybWidget.MySYB

-- |Creates an instance with a specific constructor.
instanceFromConstr :: forall a ctx. Data ctx a => 
                      Proxy ctx
                   -> Constr
                   -> Maybe a     -- ^Returns Nothing if it was not possible to create the value.
instanceFromConstr ctx constr = fromConstrM ctx (createInstance ctx) constr

-- The function below is heavily inspired of "Test-data generator"
-- example from SYB2 paper.
--
-- |Creates an instance of a Haskell type. For this to work the compiler
--  must be able to deduce the type from the callee's context.
createInstance :: forall a ctx. Data ctx a => 
                  Proxy ctx
               -> Maybe a
createInstance ctx = helper 1  -- Zero newer returns anything
    where
      --helper :: Int -> a
      helper 8   = Nothing   -- Make sure we do not to loop eternally or for a very, very long time.
      helper x   = if (length generate) == 0
                     then helper (x+1)
                     else Just $ head generate
          where
            generate = gGenUpTo ctx x

-- |Like 'createInstance' excepts it uses a phantom type to elicit the
--  correct type to return.
createInstance' :: forall a ctx. Data ctx a => 
                   Proxy ctx
                -> a
                -> Maybe a
createInstance' ctx _ = createInstance ctx

-- This code is heavily inspired of the "Test-data generator" example in the SYB2 paper.

-- |Generates all possible instances of a, while using no more
-- than n levels of recursion. Each subtype requires another level
-- of recursion. For example:
--
-- Branch (Branch Leaf 17) (Leaf 3)
--
-- would require 4 levels of recursion. One for the first branch,
-- one for second branch, one for the left Leaf, and one for the
-- Int (the seventeen). The right part of the first branch (Left
-- 3) would be done in two recursions.
gGenUpTo :: forall a ctx. Data ctx a =>
            Proxy ctx
         -> Int   -- ^ Max number of recursions
         -> [a]
gGenUpTo _ 0 = []
gGenUpTo ctx d = result
        where
          -- Recurse per possible constructor
          result = concat (map recurse cons)
          -- Retrieve constructors of the requested type
          -- cons :: (Data ctx a) => ctx() -> [Constr]
          cons = case dataTypeRep ty of
                   AlgRep cs   -> cs
                   IntRep      -> [mkIntConstr ty 0]
                   FloatRep    -> [mkFloatConstr ty 0]
                   StringRep   -> [mkStringConstr ty "f"] -- Also used for char, so we changed foo to f
                                                          -- Or Maybe SYB3/Instances.hs should be changed
                   NoRep       -> [] -- error "InstanceCreator: NoRep"
              where
                ty = dataTypeOf ctx (head result)
          -- Find all terms headed by a specific Constr
          recurse :: Constr -> [a]
          recurse = fromConstrM ctx (gGenUpTo ctx (d-1))