module struct

import StdEnv
import StdGeneric
import StdDebug

import Text

import Data.Functor
import Control.Applicative

toEnumValue :: GenericConsDescriptor -> String
toEnumValue gcd = gcd.gcd_type_def.gtd_name +++ "_" +++ gcd.gcd_name

toEnumType :: GenericTypeDefDescriptor -> String
toEnumType gtd = "enum cleanc_" +++ gtd.gtd_name

class gGenerateC a | gToCType{|*|}, gToCValue{|*|}, gToCEnums{|*|} a

:: CInfo a = {header :: String , toValue :: a -> String}

generateCInfo :: CInfo a | gGenerateC a
generateCInfo =
	let
		(CEnums enums) = cast res gToCEnums{|*|}
		(SM types) = cast res gToCType{|*|}
		res =
			{ header = concat
				[ join "\n" (removeDup (sort enums))
				, "\n\n"
				, concat (types {fresh=0,inRecord=False,indent=0} [])
				, ";"
				]
			, toValue = \a->concat (gToCValue{|*|} a [])
			}
	in res
where
	cast :: (v a) -> ((w a) -> w a)
	cast _ = id

generic gToCType a :: Structmaker a
:: Structmaker a = SM (SData [String] -> [String]) | StructMakerOnzin a
:: SData = {indent :: Int, fresh :: Int, inRecord :: Bool}
indent s c = [createArray s.indent '\t':c]
show str s c = indent s [str:c]

gToCType{|Int|}  = SM (show "uint64_t")
gToCType{|Real|} = SM (show "double") 
gToCType{|Bool|} = SM (show "bool")
gToCType{|UNIT|} = SM \_->id
gToCType{|EITHER|} (SM fl) (SM fr) = SM \s->fl s o fr s
gToCType{|PAIR|} (SM fl) (SM fr)
	 = SM \s c
		| s.inRecord = fl s (fr s c)
		= fl s [" f", toString s.fresh, ";\n":fr {s & fresh=s.fresh+1} c]
gToCType{|OBJECT of gtd|} (SM f)
	//Newtype
	| gtd.gtd_num_conses == 0 = SM f
	= SM \s c
		//Enumeration (no data)
		| and [gcd.gcd_arity == 0\\gcd<-gtd.gtd_conses] = indent s [toEnumType gtd:c]
		//Regular ADTs
		# s` = {s & indent = s.indent + 1}
		= indent s ["struct clean_", gtd.gtd_name, " {\n":
			indent s` [toEnumType gtd, " cons;\n":
			indent s` ["union {\n":
			f {s` & indent=s`.indent+1, inRecord=False} (indent s` ["} data;\n":
			indent s ["}":c]])]]]
gToCType{|CONS of gcd|} (SM f)
	//No data field
	| gcd.gcd_arity == 0 = SM \_->id
	//Only one data field
	| gcd.gcd_arity == 1 = SM \s c->f s [" ", gcd.gcd_name, ";\n":c]
	= SM \s c->indent s ["struct {\n":f {s & indent=s.indent+1} [" f", toString (gcd.gcd_arity - 1), ";\n":indent s ["} ", gcd.gcd_name, ";\n":c]]]
gToCType{|RECORD of grd|} (SM f)
	= SM \s c->indent s ["struct clean_", grd.grd_name, " {\n": f {s & indent=s.indent+1, inRecord=True} (indent s ["}":c])]
gToCType{|FIELD of gfd|} (SM f) = SM \s c->f s [" ", gfd.gfd_name,";\n":c]

:: CEnums a = CEnums [String] | CEnumsOnzin a
generic gToCEnums a :: CEnums a
gToCEnums{|a|} = CEnums []
gToCEnums{|UNIT|} = CEnums []
gToCEnums{|EITHER|} (CEnums fl) (CEnums fr) = CEnums (fl ++ fr)
gToCEnums{|PAIR|} (CEnums fl) (CEnums fr) = CEnums (fl ++ fr)
gToCEnums{|OBJECT of gtd|} (CEnums f) = CEnums [concat [toEnumType gtd, " {", join ", " (map toEnumValue gtd.gtd_conses), "};"]:f]
gToCEnums{|CONS|} (CEnums f) = CEnums f
gToCEnums{|RECORD|} (CEnums f) = CEnums f
gToCEnums{|FIELD|} (CEnums f) = CEnums f

generic gToCValue a :: a [String] -> [String]
gToCValue{|Int|} i c = [toString i:c]
gToCValue{|Real|} r c = [toString r:c]
gToCValue{|Bool|} b c = [if b "true" "false":c]
gToCValue{|UNIT|} _ _ = []
gToCValue{|EITHER|} fl _ (LEFT l) c = fl l c
gToCValue{|EITHER|} _ fr (RIGHT l) c = fr l c
gToCValue{|PAIR|} fl fr (PAIR l r) c = fl l [", ":fr r c]
gToCValue{|OBJECT of gtd|} f (OBJECT a) c
	//Newtype
	| gtd.gtd_num_conses == 0 = f a c
	| and [gcd.gcd_arity == 0\\gcd<-gtd.gtd_conses] = f a c
	= ["{":f a ["}":c]]
gToCValue{|CONS of gcd|} f (CONS a) c
	//No data field
	| gcd.gcd_arity == 0 = [toEnumValue gcd:c]
	| gcd.gcd_arity == 1 = [" .cons=",toEnumValue gcd,", .data.",gcd.gcd_name,"=":f a c]
	= [" .cons=",toEnumValue gcd,", .data.",gcd.gcd_name,"={":f a ["} ":c]]
gToCValue{|RECORD|} f (RECORD a) c = ["{":f a ["}":c]]
gToCValue{|FIELD of gfd|} f (FIELD a) c = [" .", gfd.gfd_name, "=": f a c]

:: DHTDetails
	= DHT Int Bool
	| SHT Addr
	| XXX Int Int Int
	| XXY Int Int DHTType

:: Addr =: Addr Int

:: DHTType = DHT11 | DHT12 | DHT22

derive class gGenerateC DHTDetails, DHTType, Addr, Record

Start :: CInfo Record
Start = generateCInfo

:: Record =
	{ field1 :: Int
	, field2 :: Bool
	, field3 :: DHTType
	, field4 :: DHTDetails
	}