{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
-- |a implement of `AI.Heukarya.Gene`
module AI.Heukarya.Gene.Dynamic(
  module ST
-- *implements of Gene  
  ,Dynamic(..)
-- *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 Control.Monad.ST.Safe as ST
import Data.Text(Text,append,pack,unpack)

instance Monad m => HeukaryaGene m Dynamic where
  evalTreeGene tree = return . foldl dynApp (rootLabel tree) =<< (sequence $ map evalTreeGene (subForest tree))
  geneHTypes dynam = return $ 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)
  instanceOf _ = \x y -> return (x == y)

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
