{-#LANGUAGE OverloadedStrings #-}
{-#LANGUAGE FlexibleContexts, MultiParamTypeClasses #-}
{-#LANGUAGE OverloadedLabels #-}
{-#LANGUAGE StandaloneDeriving#-}
{-#LANGUAGE QuasiQuotes #-}
{-#LANGUAGE TemplateHaskell, DataKinds #-}
module Network.SC2.Internal.ConstantGenerator where 

import Prelude hiding ((.))
import Control.Category((.))
import Data.Aeson
import System.FilePath
import System.Directory (getHomeDirectory, doesFileExist)
import Network.SC2.Internal.Directories
import Language.Haskell.TH.Syntax
import Language.Haskell.TH
import Language.Haskell.TH.Quote
import qualified Data.Text as T (pack, unpack, Text, append, words, toTitle,toUpper, concat, isSuffixOf)
import Network.SC2.Internal.Types
import Data.Char (toUpper)
import Lens.Labels hiding ((^.), (.~))
import Lens.Labels.Unwrapped
import Data.Maybe
import Control.Lens



readStableIDjson :: IO (FilePath, IDs)
readStableIDjson = do
    home <- getHomeDirectory
    let path' = home </> userSC2SubDirectory </> "stableid.json"
    exists <- doesFileExist path'
    let path = if exists then path' else "backupStableID.json"
    contents' <- decodeFileStrict' path :: IO (Maybe IDs)
    let contents = fromMaybe (error "Error parsing stableid.json") contents'
    return (home, contents)


    

stableIDjsonContents :: Q IDs
stableIDjsonContents = do    
    (path, contents) <- runIO readStableIDjson
    --FIXME: addDependentFile is causing a permisison error. Unsure if with stack or GHC.
    --addDependentFile path
    return contents

scAbilitiesDeclarations :: Q [Dec]
scAbilitiesDeclarations = do    
    contents <- stableIDjsonContents
    let (ha:ra) = filter (\a -> not (Data.Maybe.isJust (remapID a) || abilityButtonName a == "") ) $ abilities contents 
    let abilities' = (ha & #canonicalName .~ "NullAbility" ) : ra   
    scEntityEnumGen "ability" abilities'

scBuffsDeclarations :: Q [Dec]
scBuffsDeclarations = do
    contents <- stableIDjsonContents
    let (hb:rb) = buffs contents
    let buffs' = (hb & #canonicalName .~ "NullBuff" ) : rb
    scEntityEnumGen "buff" buffs'
scEffectsDeclarations :: Q [Dec]
scEffectsDeclarations = do
    contents <- stableIDjsonContents
    let (he:re) = effects contents
    let effects' = (he & #canonicalName .~ "NullEffect" ) : re
    scEntityEnumGen "effect" effects'
scUpgradesDeclarations :: Q [Dec]
scUpgradesDeclarations = do
    contents <- stableIDjsonContents
    let (hu:ru)  = upgrades contents
    let upgrades' = (hu & #canonicalName .~ "NullUpgrade" ) : ru
    scEntityEnumGen "upgrade" upgrades'
scUnitsDeclarations :: Q [Dec]
scUnitsDeclarations = do
    contents <- stableIDjsonContents
    let units' = units contents
    scEntityEnumGen "unit" units'



        
        
sanitiseName :: T.Text -> String
sanitiseName name = let titled = T.unpack name in
    case titled of
        ('1':'0':rest) -> "Ten" ++ rest
        ('1':'2':rest) -> "Twelve" ++ rest
        ('1':'4':rest) -> "Fourteen" ++ rest
        ('1':'6':rest) -> "Sixteen" ++ rest
        ('1':'8':rest) -> "Eighteen" ++ rest
        ('2':'0':rest) -> "Twenty" ++ rest
        ('2':'2':rest) -> "TwentyTwo" ++ rest
        ('2':'4':rest) -> "TwentyFour" ++ rest
        ('2':'5':'0':rest) -> "TwoFifty" ++ rest
        ('3':'3':'0':rest) -> "ThreeThirty" ++ rest
        ('1':rest) -> "One" ++ rest
        ('2':rest) -> "Two" ++ rest
        ('3':rest) -> "Three" ++ rest
        ('4':rest) -> "Four" ++ rest
        ('5':rest) -> "Five" ++ rest
        ('6':rest) -> "Six" ++ rest
        ('7':rest) -> "Seven" ++ rest
        ('8':rest) -> "Eight" ++ rest
        ('9':rest) -> "Nine" ++ rest
        ('0':rest) -> "Zero" ++ rest
        --todo: the rest as appropriate 
        (t:rest)   -> toUpper t : rest

instance HasLens' Ability "canonicalName" T.Text where
            lensOf' _ = lens theName (\a n -> a{abilityName = n}) where      
                         
                theName (Ability _ "TerranBuild" "Cancel" Nothing _ Nothing) = "HaltTerranBuild"
                theName (Ability _ "ProtossBuild" "Cancel" Nothing _ Nothing) = "HaltProtossBuild"
                theName (Ability _ "ZergBuild" "Cancel" Nothing _ Nothing) = "HaltZergBuild"
                theName (Ability _ "TerranBuild" bName Nothing _ Nothing) = "Build" `T.append` bName
                theName (Ability _ "ProtossBuild" bName Nothing _ Nothing) = "Build" `T.append` bName
                theName (Ability _ "ZergBuild" bName Nothing _ Nothing) = "Build" `T.append` bName                
                theName (Ability _ "WarpGateTrain" bName Nothing _ Nothing) = "WarpGateTrain" `T.append` bName
                theName (Ability _ "SuperWarpGateTrain" bName Nothing _ Nothing) = "SuperWarpGateTrain" `T.append` bName
                theName (Ability _ name bName Nothing 0 Nothing) = (if "Train" `T.isSuffixOf` name then "Train" else name) `T.append` bName
                theName (Ability _ name bName _ _ _ ) | T.toUpper name == T.toUpper bName = (T.concat . fmap T.toTitle . T.words) name                
                theName (Ability _ name bName Nothing idx Nothing) = if "Train" `T.isSuffixOf` name 
                    then "Train" `T.append` bName 
                    else name `T.append` bName`T.append` (T.pack . show $ idx)
                theName (Ability _ name bName (Just fName) idx Nothing) = T.concat . fmap T.toTitle . T.words $ fName
                theName a = error (show a)

data EntityDecls = EntityDecls {constructor :: Con, fromClause :: Clause, toClause :: Clause}
scEntityEnumGen :: RawIDMappable a => String -> [a] -> Q [Dec]
scEntityEnumGen nameLower@(firstLetter:restName) entities = go where
    nameUpper = toUpper firstLetter : restName
    typeName = mkName (nameUpper ++ "Type")
    typeDecl = DataD [] typeName [] Nothing cons []
    vals = map con entities
    cons = map constructor vals
    con entity = let
                    name = entity ^. #canonicalName . to sanitiseName . to mkName
                    rawid = entity ^. #id      
                    conC = NormalC name []
                    fromClause = Clause [LitP (IntegerL rawid)] (NormalB (ConE name)) []
                    toClause' = Clause [ConP name []] (NormalB (LitE (IntegerL rawid))) []
               in EntityDecls {constructor = conC, fromClause = fromClause, toClause = toClause'} 
    entityFromIntName = mkName "fromInt"
    entityFromIntDefault = Clause [WildP] (NormalB (AppE (VarE entityFromIntName) (LitE(IntegerL 0)))) []
    fromIntDecl = FunD  entityFromIntName (map fromClause vals ++ [entityFromIntDefault])

    entityToIntName = mkName "toInt"
    entityToIntDefault = Clause [WildP] (NormalB ((LitE(IntegerL 0)))) []
    toIntDecl = FunD  entityToIntName (map toClause vals ++ [entityToIntDefault])
    instances' = let name = conT typeName in [d|
        deriving instance Eq $name
        deriving instance Show $name
        deriving instance Enum $name
        deriving instance Bounded $name
        |]
    go = do
        instances <- instances'
        return ([typeDecl, fromIntDecl, toIntDecl] ++ instances)