{-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleContexts, TypeFamilies #-} {-# OPTIONS_GHC -F -pgmFtrhsx #-} module HSP.Google.Analytics ( UACCT(..) , analytics , addAnalytics , analyticsAsync ) where import Data.Generics (Data, Typeable) import HSP import Prelude hiding (head) newtype UACCT = UACCT String -- ^ The UACCT provided to you by Google (looks like: @UA-XXXXX-X@) deriving (Read, Show, Eq, Ord, Typeable, Data) -- | create the google analytics asynchronous tracking script tag -- -- NOTE: you must put this right before the \<\/head\> tag analyticsAsync :: (XMLGenerator m) => UACCT -- ^ web property ID (looks like: @UA-XXXXX-X@) -> GenXML m analyticsAsync (UACCT uacct) = -- | create the (old) google analytics script tags -- -- NOTE: you must put the <% analytics yourUACCT %> immediately before the tag -- -- You probably want to use 'analyticsAsync' instead. -- -- See also: 'addAnalytics', 'analyticsAsync' analytics :: (XMLGenerator m) => UACCT -> GenXMLList m analytics (UACCT uacct) = do a <- b <- return [a,b] -- | automatically add the google analytics scipt tags immediately before the element -- NOTE: this function is not idepotent addAnalytics :: ( AppendChild m XML , EmbedAsChild m XML , EmbedAsAttr m Attribute , XMLGenerator m , XMLType m ~ XML) => UACCT -> XMLGenT m XML -> GenXML m addAnalytics uacct pg = do page <- pg a <- analytics uacct case page of <[ head, body ]> -> <% head %> <% body <: (a :: [XML]) %> o -> error ("Failed to add analytics." ++ show o) {- Example Analytics Code from Google: -}