1 {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
    2 
    3 {-# OPTIONS -fglasgow-exts #-}
    4 
    5 -- |Contains functions to automatically create instances from
    6 -- data type definitions.
    7 module Graphics.UI.SybWidget.InstanceCreator
    8     ( gGenUpTo
    9     , createInstance, createInstance'
   10     , instanceFromConstr
   11     )
   12 
   13 where
   14 
   15 import Graphics.UI.SybWidget.MySYB
   16 
   17 -- |Creates an instance with a specific constructor.
   18 instanceFromConstr :: forall a ctx. Data ctx a => 
   19                       Proxy ctx
   20                    -> Constr
   21                    -> Maybe a     -- ^Returns Nothing if it was not possible to create the value.
   22 instanceFromConstr ctx constr = fromConstrM ctx (createInstance ctx) constr
   23 
   24 -- The function below is heavily inspired of "Test-data generator"
   25 -- example from SYB2 paper.
   26 --
   27 -- |Creates an instance of a Haskell type. For this to work the compiler
   28 --  must be able to deduce the type from the callee's context.
   29 createInstance :: forall a ctx. Data ctx a => 
   30                   Proxy ctx
   31                -> Maybe a
   32 createInstance ctx = helper 1  -- Zero newer returns anything
   33     where
   34       --helper :: Int -> a
   35       helper 8   = Nothing   -- Make sure we do not to loop eternally or for a very, very long time.
   36       helper x   = if (length generate) == 0
   37                      then helper (x+1)
   38                      else Just $ head generate
   39           where
   40             generate = gGenUpTo ctx x
   41 
   42 -- |Like 'createInstance' excepts it uses a phantom type to elicit the
   43 --  correct type to return.
   44 createInstance' :: forall a ctx. Data ctx a => 
   45                    Proxy ctx
   46                 -> a
   47                 -> Maybe a
   48 createInstance' ctx _ = createInstance ctx
   49 
   50 -- This code is heavily inspired of the "Test-data generator" example in the SYB2 paper.
   51 
   52 -- |Generates all possible instances of a, while using no more
   53 -- than n levels of recursion. Each subtype requires another level
   54 -- of recursion. For example:
   55 --
   56 -- Branch (Branch Leaf 17) (Leaf 3)
   57 --
   58 -- would require 4 levels of recursion. One for the first branch,
   59 -- one for second branch, one for the left Leaf, and one for the
   60 -- Int (the seventeen). The right part of the first branch (Left
   61 -- 3) would be done in two recursions.
   62 gGenUpTo :: forall a ctx. Data ctx a =>
   63             Proxy ctx
   64          -> Int   -- ^ Max number of recursions
   65          -> [a]
   66 gGenUpTo _ 0 = []
   67 gGenUpTo ctx d = result
   68         where
   69           -- Recurse per possible constructor
   70           result = concat (map recurse cons)
   71           -- Retrieve constructors of the requested type
   72           -- cons :: (Data ctx a) => ctx() -> [Constr]
   73           cons = case dataTypeRep ty of
   74                    AlgRep cs   -> cs
   75                    IntRep      -> [mkIntConstr ty 0]
   76                    FloatRep    -> [mkFloatConstr ty 0]
   77                    StringRep   -> [mkStringConstr ty "f"] -- Also used for char, so we changed foo to f
   78                                                           -- Or Maybe SYB3/Instances.hs should be changed
   79                    NoRep       -> [] -- error "InstanceCreator: NoRep"
   80               where
   81                 ty = dataTypeOf ctx (head result)
   82           -- Find all terms headed by a specific Constr
   83           recurse :: Constr -> [a]
   84           recurse = fromConstrM ctx (gGenUpTo ctx (d-1))
   85