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