{-# LANGUAGE OverloadedStrings #-}
module Yesod.EmbeddedStatic.AngularJsMangle (
    parseDirectiveFiles
  , parseDirectiveFile
  , cleanupDIFile
) where

import Blaze.ByteString.Builder (toLazyByteString)
import Data.List (intersperse)
import Data.Maybe (catMaybes)
import Language.JavaScript.Parser
import Language.JavaScript.Parser.AST
import System.Directory (doesFileExist)
import System.FilePath

import qualified Data.ByteString.Lazy as BL

-------------------------------------------------------------------------------
-- Dependency Injection Cleanup
-------------------------------------------------------------------------------

-- | Parse the javascript file and convert all DI functions that rely on variable names to use
-- inline annotation so that the javascript can be minimized.
cleanupDIFile :: FilePath -> IO BL.ByteString
cleanupDIFile f = toLazyByteString . renderJS . cleanupDI <$> parseFile f

cleanupDI :: JSAST -> JSAST
cleanupDI (JSAstProgram exprs _) = JSAstProgram (map diTopExpr exprs) JSNoAnnot
cleanupDI x = x

diTopExpr :: JSStatement -> JSStatement
diTopExpr (JSMethodCall
            call@(JSMemberDot
                (JSIdentifier _ "module")
                _
                (JSIdentifier _ func))
            _
            argsCommaList
            _
            semi)
    = JSMethodCall call JSNoAnnot (diCommaList (func == "directive") argsCommaList) JSNoAnnot semi
diTopExpr x = x

diCommaList :: Bool -> JSCommaList JSExpression -> JSCommaList JSExpression
diCommaList _ JSLNil = JSLNil
diCommaList isDir (JSLOne x) = JSLOne $ diFuncExpr isDir x
diCommaList isDir (JSLCons h _ x) = JSLCons (diCommaList isDir h) JSNoAnnot (diFuncExpr isDir x)

-- | DI a single argument which is a function expression
diFuncExpr :: Bool -> JSExpression -> JSExpression
diFuncExpr isDir (JSFunctionExpression _ ident _ params _ body) =
        case params of
            JSLNil -> func
            _  -> JSArrayLiteral JSNoAnnot elems JSNoAnnot
    where
        body' = if isDir then diBody body else body
        func = JSFunctionExpression JSNoAnnot ident JSNoAnnot params JSNoAnnot body'

        elems :: [JSArrayElement]
        elems = intersperse (JSArrayComma JSNoAnnot) $ map diParam (jsToList params) ++ [JSArrayElement func]
diFuncExpr _ x = x

-- | Convert a function parameter to a string literal
diParam :: JSIdent -> JSArrayElement
diParam (JSIdentName _ name) = JSArrayElement $ JSStringLiteral JSNoAnnot ("\"" ++ name ++ "\"")
diParam JSIdentNone = JSArrayElement (JSDecimal JSNoAnnot "0")

-- | Check a directive body to see if we need to DI cleanup a controller.
diBody :: JSBlock -> JSBlock
diBody (JSBlock _ statements _) = JSBlock JSNoAnnot (map diReturn statements) JSNoAnnot

-- | Check if a statement is a return of an object literal
diReturn :: JSStatement -> JSStatement
diReturn (JSReturn _ (Just (JSObjectLiteral _ props _)) semi)
    = JSReturn JSNoAnnot (Just (JSObjectLiteral JSNoAnnot (diPropertyList props) JSNoAnnot)) semi
diReturn x = x

diPropertyList :: JSObjectPropertyList -> JSObjectPropertyList
diPropertyList (JSCTLComma x _) = JSCTLNone $ diPropertyList' x
diPropertyList (JSCTLNone x) = JSCTLNone $ diPropertyList' x

diPropertyList' :: JSCommaList JSObjectProperty -> JSCommaList JSObjectProperty
diPropertyList' (JSLCons h _ x) = JSLCons (diPropertyList' h) JSNoAnnot (diProperty x)
diPropertyList' (JSLOne x) = JSLOne $ diProperty x
diPropertyList' JSLNil = JSLNil

testPropName :: String -> JSPropertyName -> Bool
testPropName n (JSPropertyIdent _ n') = n == n'
testPropName n (JSPropertyString _ n') = "'" ++ n ++ "'" == n' || "\"" ++ n ++ "\"" == n'
testPropName _ _ = False

-- | Check a property of an object for controller
diProperty :: JSObjectProperty -> JSObjectProperty
diProperty (JSPropertyNameandValue prop _ args)
        | testPropName "controller" prop = JSPropertyNameandValue prop JSNoAnnot args'
    where
        args' = map (diFuncExpr False) args
diProperty x = x

-------------------------------------------------------------------------------
-- Loading directive IDs
-------------------------------------------------------------------------------

-- | Parse all the javascript files.  If the javascript file is a directive,
-- the directive has a templateUrl, and there is a matching hamlet file, add the
-- (id, hamlet file) into the return list.
parseDirectiveFiles :: FilePath -> [FilePath] -> IO [(String,FilePath)]
parseDirectiveFiles dir jsfiles = catMaybes <$> mapM parseDirectiveFile (map (dir</>) jsfiles)

-- | Check a single javascript file to see if it is a directive
parseDirectiveFile :: FilePath -> IO (Maybe (String, FilePath))
parseDirectiveFile f = do
    j <- parseFile f
    case parseDirId j of
        Nothing -> return Nothing
        Just i -> do
            let hamlet = replaceExtension f "hamlet"
            e <- doesFileExist hamlet
            if e
                then return $ Just (i, hamlet)
                else return Nothing

firstJust :: [Maybe a] -> Maybe a
firstJust [] = Nothing
firstJust (x@(Just _):_) = x
firstJust (Nothing:xs) = firstJust xs

-- | Search for the directive ID 
parseDirId :: JSAST -> Maybe String
parseDirId (JSAstProgram es _) = firstJust $ map parseDirectiveCall es
parseDirId _ = Nothing

jsToList :: JSCommaList a -> [a]
jsToList JSLNil = []
jsToList (JSLOne x) = [x]
jsToList (JSLCons h _ x) = jsToList h ++ [x]

-- | Parse module.directive(... function(..) {
parseDirectiveCall :: JSStatement -> Maybe String
parseDirectiveCall (JSMethodCall
                        (JSMemberDot
                            (JSIdentifier _ "module")
                            _
                            (JSIdentifier _ "directive"))
                        _ -- annotation
                        argsCommalist
                        _ --annotation
                        _) -- semi colon
    = firstJust $ map parseDirArg $ jsToList argsCommalist
parseDirectiveCall _ = Nothing

-- | check the function argument to the directive call
parseDirArg :: JSExpression -> Maybe String
parseDirArg (JSFunctionExpression _ _ _ _ _ (JSBlock _ statements _)) = firstJust $ map parseDirSt statements
parseDirArg _ = Nothing

-- | Check a statement inside the factory function for  return { .. };
parseDirSt :: JSStatement -> Maybe String
parseDirSt (JSReturn _ (Just (JSObjectLiteral _ props _)) _) = result
    where
        propsLst = case props of
                    (JSCTLComma x _) -> jsToList x
                    (JSCTLNone x) -> jsToList x
        result = firstJust $ map parseDirTUrl propsLst
parseDirSt _ = Nothing

-- | Check a property in the object literal
parseDirTUrl :: JSObjectProperty -> Maybe String
parseDirTUrl (JSPropertyNameandValue prop _ [JSStringLiteral _ tUrl])
    | testPropName "templateUrl" prop = Just (drop 1 $ take (length tUrl - 1) tUrl) -- the string literal has quotes around it
parseDirTUrl _ = Nothing