{-# LANGUAGE OverloadedStrings#-}
-- |a implement of `AI.Heukarya.Gene`
module AI.Heukarya.Gene.Dynamic(
-- *implements of Gene  
  evalTreeGene
  ,geneTypeRep
  ,geneHTypes
  ,outputHTreeType
-- *wrap functions from `Data.Dynamic`
  ,toDyn
  ,fromDyn
  ,fromDynamic
  ,dynApp
  ,dynApply
  ,dynTypeRep
) where

import AI.Heukarya.Gene
import qualified Data.Dynamic as D
import Data.List
import Data.Typeable
import Data.Maybe
import Data.Tree
import Control.DeepSeq
import Data.Text(Text,append,pack,unpack)

instance HeukaryaGene Dynamic where
  evalTreeGene tree =
    foldl dynApp (rootLabel tree) (map evalTreeGene (subForest tree))
  geneTypeRep = (pack.show.dynTypeRep)
  geneHTypes dynam = hType (lengthType dynam) (dynTypeRep dynam) [] []
    where
    hType n ty i res = let splited = typeRepArgs ty in 
      if n == 0
        then reverse $ map (\(x,y)->(map (pack.show) $ reverse x,(pack.show) y)) res
        else hType (n-1) (last splited) (head splited:i) ((i,ty):res)
  outputHTreeType tree =  snd $ geneHTypes (rootLabel tree)!!length (subForest tree)
  instanceOf _ = (==)

lengthType = length.expandType.dynTypeRep
expandType x =
  head splited : if length splited < 2 then [] else expandType (last splited)
  where
  splited = typeRepArgs x



data Dynamic = Dynamic {dynSym::Text, dyn::D.Dynamic}

toDyn sym a = Dynamic sym (D.toDyn a)

fromDyn (Dynamic _ a) b =
  D.fromDyn a b

fromDynamic (Dynamic _ a) =
  D.fromDynamic a

dynApply (Dynamic syma a) (Dynamic symb b) =
  if isNothing (D.dynApply a b) then Nothing else Just ( Dynamic
    ("(" `append` syma `append` " " `append` symb `append` ")") (D.dynApp a b)
  )

dynApp (Dynamic syma a) (Dynamic symb b) =
  Dynamic
    ("(" `append` syma `append` " " `append` symb `append` ")") (D.dynApp a b)

dynTypeRep (Dynamic _ a) =
  D.dynTypeRep a

instance Show Dynamic where
  show (Dynamic sym _) = unpack sym

instance Eq Dynamic where
  (Dynamic syma a) == (Dynamic symb b) = syma == symb

instance Ord Dynamic where
  (Dynamic syma a) <= (Dynamic symb b) = syma <= symb

instance NFData Dynamic where