module Language.Clafer.IG.Sugarer (sugarClaferModel) where
import Language.Clafer.IG.ClaferModel
import qualified Language.Clafer.Intermediate.Analysis as Analysis
import Data.Maybe (fromJust)
import Data.List as List hiding (map)
import Data.Map as Map hiding (map, foldr, foldl)
import Prelude hiding (id)
data Census = Census 
    (Map Id (Int, String))  
    (Map String Int)        
 deriving Show
poll :: Id -> Census -> Census
poll id (Census sample' counts') =
    Census sample'' counts''
    where
    fullName = i_name id
    name = makeSimpleName fullName
    counts'' = insertWith (+) name 1 counts'
    ordinal' = findWithDefault (error $ "Did not find " ++ name ++ " in counts.") name counts''
    sample'' = insertWith (error $ "Polled " ++ fullName ++ " twice in the census.") id (ordinal', name) sample'
    
    makeSimpleName :: String -> String
    makeSimpleName name' = case dropWhile (/='_') name' of
        "" ->  error "Unexpected Clafer name " ++ name'
        x -> tail x
claferModelCensus :: ClaferModel -> Census
claferModelCensus (ClaferModel topLevelClafers) =
    clafersCensus (Census Map.empty Map.empty) topLevelClafers
    where
    clafersCensus = foldl claferCensus
    claferCensus census Clafer{c_id=id, c_children=children} = poll id (clafersCensus census children) 
sugarClaferModel:: Bool -> Bool  -> Maybe Analysis.Info -> ClaferModel -> (Map Int String) -> ClaferModel
sugarClaferModel   useUids addTypes info model@(ClaferModel topLevelClafers) sMap =
    ClaferModel $ map sugarClafer topLevelClafers
    where
    sugarClafer (Clafer id value children) = 
        Clafer (sugarId useUids addTypes True id) (sugarValue (Clafer id value children)) (map sugarClafer children)
    sugarValue (Clafer _ (Just (AliasValue alias)) _) = Just $ AliasValue $ sugarId useUids addTypes False alias
    sugarValue (Clafer _ Nothing _) = Nothing
    sugarValue c  = if (cType c) == "string" then (Just ((StringValue) (getString c))) else (c_value c)
    cType (Clafer id _ _) = 
        case (fromJust (Analysis.super (Analysis.runAnalysis (Analysis.claferWithUid (i_name id)) (fromJust info)))) of
            (Analysis.Ref s) -> cTypeSolve s
            (Analysis.Colon s) -> cTypeSolve s
    
    cTypeSolve "string" = "string"
    cTypeSolve "integer" = "integer"
    cTypeSolve "int" = "integer"
    cTypeSolve "real" = "real"
    cTypeSolve x = cType (Clafer (Id x 0) Nothing []) 
    getString c = case (Map.lookup strNumber sMap) of
        Nothing -> "\"<text " ++ show strNumber ++ ">\""
        Just s -> s
        where strNumber = v_value  $ fromJust  $ c_value c
    
    Census sample' counts' = claferModelCensus model
    
    sugarId :: Bool -> Bool  -> Bool    -> Id -> Id
    sugarId    useUids' addTypes' addRefDecl id  =
        Id (finalName ++ ordinalDisplay ++ (refDecl addTypes' addRefDecl info)) 0  
        where
        fullName = i_name id
        ordinalDisplay = if (useUids || count > 1)
                         then "$" ++ show ordinal
                         else ""
        refDecl :: Bool -> Bool -> Maybe Analysis.Info -> String
        refDecl    True    True    (Just info')          = retrieveSuper info' $ i_name id
        refDecl    _       _       _                    = ""
        
        (ordinal, simpleName) = findWithDefault (error $ "Sample lookup " ++ show id ++ " failed.") id sample'
        count = findWithDefault (error $ "Count lookup " ++ simpleName ++ " failed.") simpleName counts'
        finalName = if useUids' then fullName else simpleName
retrieveSuper :: Analysis.Info -> String -> String
retrieveSuper info uid = 
    if (Analysis.isBase sclafer)
        then ""
        else maybe "" sugarSuper (Analysis.super sclafer)
    where
        sclafer = Analysis.runAnalysis (Analysis.claferWithUid uid) info
        sugarSuper :: Analysis.SSuper -> String
        sugarSuper (Analysis.Ref s) = " -> " ++ s
        sugarSuper (Analysis.Colon s) = " : " ++ s