├── .gitignore ├── .gitmodules ├── .travis.yml ├── Controller.hs ├── Handler ├── Home.hs ├── Reports.hs └── Reports │ └── Helpers.hs ├── LICENSE ├── Model.hs ├── ProfilingReport.hs ├── README.markdown ├── Setup.hs ├── TKYProf.hs ├── bin ├── prof2json.hs └── tkyprof.hs ├── config ├── Settings.hs ├── StaticFiles.hs ├── favicon.png └── routes ├── materials ├── snail-black.svgz └── snail.svgz ├── static ├── images │ └── tkyprof-logo-orange.png └── js │ ├── d3.layout.min.js │ ├── d3.min.js │ ├── jquery.fileupload.js │ ├── jquery.iframe-transport.js │ ├── jquery.pjax.js │ ├── jquery.ui.widget.js │ └── tkyprof.js ├── templates ├── default-layout.hamlet ├── default-layout.lucius ├── header.hamlet ├── header.lucius ├── home.hamlet ├── home.julius ├── home.lucius ├── reports-id.hamlet ├── reports-id.julius ├── reports-id.lucius ├── reports.hamlet ├── reports.julius └── reports.lucius └── tkyprof.cabal /.gitignore: -------------------------------------------------------------------------------- 1 | .dist-scion/ 2 | dist/ 3 | client_session_key.aes 4 | static/tmp/ 5 | /*.sublime-* 6 | /cabal-dev/ 7 | /.cabal-sandbox/ 8 | /cabal.sandbox.config 9 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "modules/d3"] 2 | path = modules/d3 3 | url = https://github.com/maoe/d3.git 4 | [submodule "modules/jQuery-File-Upload"] 5 | path = modules/jQuery-File-Upload 6 | url = https://github.com/blueimp/jQuery-File-Upload.git 7 | [submodule "modules/jquery-ui"] 8 | path = modules/jquery-ui 9 | url = https://github.com/jquery/jquery-ui.git 10 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # NB: don't set `language: haskell` here 2 | 3 | # See also https://github.com/hvr/multi-ghc-travis for more information 4 | 5 | # The following lines enable several GHC versions and/or HP versions 6 | # to be tested; often it's enough to test only against the last 7 | # release of a major GHC version. Setting HPVER implictly sets 8 | # GHCVER. Omit lines with versions you don't need/want testing for. 9 | env: 10 | - GHCVER=7.6.3 11 | - GHCVER=7.8.1 12 | - HPVER=2013.2.0.0 13 | 14 | # Note: the distinction between `before_install` and `install` is not 15 | # important. 16 | before_install: 17 | - case "$HPVER" in 18 | "") ;; 19 | 20 | "2013.2.0.0") 21 | export GHCVER=7.6.3 ; 22 | echo "constraints:async==2.0.1.4,attoparsec==0.10.4.0,case-insensitive==1.0.0.1,cgi==3001.1.7.5,fgl==5.4.2.4,GLUT==2.4.0.0,GLURaw==1.3.0.0,haskell-src==1.0.1.5,hashable==1.1.2.5,html==1.0.1.2,HTTP==4000.2.8,HUnit==1.2.5.2,mtl==2.1.2,network==2.4.1.2,OpenGL==2.8.0.0,OpenGLRaw==1.3.0.0,parallel==3.2.0.3,parsec==3.1.3,QuickCheck==2.6,random==1.0.1.1,regex-base==0.93.2,regex-compat==0.95.1,regex-posix==0.95.2,split==0.2.2,stm==2.4.2,syb==0.4.0,text==0.11.3.1,transformers==0.3.0.0,unordered-containers==0.2.3.0,vector==0.10.0.1,xhtml==3000.2.1,zlib==0.5.4.1" > cabal.config ;; 23 | 24 | "2012.4.0.0") 25 | export GHCVER=7.6.2 ; 26 | echo "constraints:async==2.0.1.3,cgi==3001.1.7.4,fgl==5.4.2.4,GLUT==2.1.2.1,haskell-src==1.0.1.5,html==1.0.1.2,HTTP==4000.2.5,HUnit==1.2.5.1,mtl==2.1.2,network==2.3.1.0,OpenGL==2.2.3.1,parallel==3.2.0.3,parsec==3.1.3,QuickCheck==2.5.1.1,random==1.0.1.1,regex-base==0.93.2,regex-compat==0.95.1,regex-posix==0.95.2,split==0.2.1.1,stm==2.4,syb==0.3.7,text==0.11.2.3,transformers==0.3.0.0,vector==0.10.0.1,xhtml==3000.2.1,zlib==0.5.4.0" > cabal.config ;; 27 | 28 | "2012.2.0.0") 29 | export GHCVER=7.4.1 ; 30 | echo "constraints:cgi==3001.1.7.4,fgl==5.4.2.4,GLUT==2.1.2.1,haskell-src==1.0.1.5,html==1.0.1.2,HTTP==4000.2.3,HUnit==1.2.4.2,mtl==2.1.1,network==2.3.0.13,OpenGL==2.2.3.1,parallel==3.2.0.2,parsec==3.1.2,QuickCheck==2.4.2,random==1.0.1.1,regex-base==0.93.2,regex-compat==0.95.1,regex-posix==0.95.1,stm==2.3,syb==0.3.6.1,text==0.11.2.0,transformers==0.3.0.0,xhtml==3000.2.1,zlib==0.5.3.3" > cabal.config ;; 31 | 32 | "2011.4.0.0") 33 | export GHCVER=7.0.4 ; 34 | echo "constraints:cgi==3001.1.7.4,fgl==5.4.2.4,GLUT==2.1.2.1,haskell-src==1.0.1.4,html==1.0.1.2,HUnit==1.2.4.2,network==2.3.0.5,OpenGL==2.2.3.0,parallel==3.1.0.1,parsec==3.1.1,QuickCheck==2.4.1.1,regex-base==0.93.2,regex-compat==0.95.1,regex-posix==0.95.1,stm==2.2.0.1,syb==0.3.3,xhtml==3000.2.0.4,zlib==0.5.3.1,HTTP==4000.1.2,deepseq==1.1.0.2" > cabal.config ;; 35 | 36 | *) 37 | export GHCVER=unknown ; 38 | echo "unknown/invalid Haskell Platform requested" ; 39 | exit 1 ;; 40 | 41 | esac 42 | 43 | - sudo add-apt-repository -y ppa:hvr/ghc 44 | - sudo apt-get update 45 | - sudo apt-get install cabal-install-1.18 ghc-$GHCVER happy 46 | - export PATH=/opt/ghc/$GHCVER/bin:$PATH 47 | 48 | install: 49 | - cabal-1.18 update 50 | - cabal-1.18 install --only-dependencies --enable-tests --enable-benchmarks 51 | 52 | # Here starts the actual work to be performed for the package under 53 | # test; any command which exits with a non-zero exit code causes the 54 | # build to fail. 55 | script: 56 | # -v2 provides useful information for debugging 57 | - cabal-1.18 configure --enable-tests --enable-benchmarks -v2 58 | 59 | # this builds all libraries and executables 60 | # (including tests/benchmarks) 61 | - cabal-1.18 build 62 | 63 | - cabal-1.18 test 64 | - cabal-1.18 check 65 | 66 | # tests that a source-distribution can be generated 67 | - cabal-1.18 sdist 68 | 69 | # check that the generated source-distribution can be built & installed 70 | - export SRC_TGZ=$(cabal-1.18 info . | awk '{print $2 ".tar.gz";exit}') ; 71 | cd dist/; 72 | if [ -f "$SRC_TGZ" ]; then 73 | cabal-1.18 install "$SRC_TGZ"; 74 | else 75 | echo "expected '$SRC_TGZ' not found"; 76 | exit 1; 77 | fi 78 | 79 | notifications: 80 | webhooks: 81 | urls: 82 | - https://webhooks.gitter.im/e/f3e6eab7b19a14343262 83 | on_success: change # options: [always|never|change] default: always 84 | on_failure: always # options: [always|never|change] default: always 85 | on_start: false # default: false 86 | 87 | # EOF 88 | -------------------------------------------------------------------------------- /Controller.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, OverloadedStrings, ViewPatterns #-} 2 | {-# OPTIONS_GHC -fno-warn-orphans #-} 3 | module Controller 4 | ( withTKYProf 5 | , withDevelApp 6 | ) where 7 | 8 | import Data.ByteString (ByteString) 9 | import Data.Dynamic (Dynamic, toDyn) 10 | import Settings 11 | import TKYProf 12 | import Yesod.Static 13 | -- Import all relevant handler modules here. 14 | import Handler.Home 15 | import Handler.Reports 16 | 17 | -- This line actually creates our YesodSite instance. It is the second half 18 | -- of the call to mkYesodData which occurs in TKYProf.hs. Please see 19 | -- the comments there for more details. 20 | mkYesodDispatch "TKYProf" resourcesTKYProf 21 | 22 | -- Some default handlers that ship with the Yesod site template. You will 23 | -- very rarely need to modify this. 24 | getFaviconR :: Handler () 25 | getFaviconR = sendFile "image/png" "config/favicon.png" 26 | 27 | getRobotsR :: Handler RepPlain 28 | getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString) 29 | 30 | -- This function allocates resources (such as a database connection pool), 31 | -- performs initialization and creates a WAI application. This is also the 32 | -- place to put your migrate statements to have automatic database 33 | -- migrations handled by Yesod. 34 | withTKYProf :: (Application -> IO a) -> IO a 35 | withTKYProf f = do 36 | rs <- atomically $ emptyReports 37 | s <- static Settings.staticdir 38 | let h = TKYProf { getStatic = s 39 | , getReports = rs } 40 | toWaiApp h >>= f 41 | 42 | withDevelApp :: Dynamic 43 | withDevelApp = toDyn (withTKYProf :: (Application -> IO ()) -> IO ()) 44 | -------------------------------------------------------------------------------- /Handler/Home.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-} 2 | module Handler.Home where 3 | import TKYProf hiding (reports) 4 | import Yesod.Form (Enctype(Multipart)) 5 | import Data.Maybe (listToMaybe) 6 | import Handler.Reports.Helpers (getAllReports) 7 | import ProfilingReport (ProfilingReport(..)) 8 | 9 | -- This is a handler function for the GET request method on the RootR 10 | -- resource pattern. All of your resource patterns are defined in 11 | -- TKYProf.hs; look for the line beginning with mkYesodData. 12 | -- 13 | -- The majority of the code you will write in Yesod lives in these handler 14 | -- functions. You can spread them across multiple files if you are so 15 | -- inclined, or create a single monolithic file. 16 | getHomeR :: Handler Html 17 | getHomeR = do 18 | reports <- getAllReports 19 | defaultLayout $ do 20 | setTitle "TKYProf" 21 | addScript $ StaticR js_jquery_ui_widget_js 22 | addScript $ StaticR js_jquery_iframe_transport_js 23 | addScript $ StaticR js_jquery_fileupload_js 24 | $(widgetFile "home") 25 | -------------------------------------------------------------------------------- /Handler/Reports.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards, NamedFieldPuns, TemplateHaskell, QuasiQuotes, OverloadedStrings #-} 2 | module Handler.Reports 3 | ( getReportsR 4 | , postReportsR 5 | , getReportsIdR 6 | , getReportsIdTimeR 7 | , getReportsIdAllocR 8 | ) where 9 | 10 | import Data.Maybe (listToMaybe) 11 | import Data.Text (Text) 12 | import Handler.Reports.Helpers (getAllReports, getProfilingReport, postProfilingReport) 13 | import ProfilingReport 14 | import TKYProf hiding (lift) 15 | import Yesod.Core (lift) 16 | import qualified Data.Aeson as A (encode) 17 | import qualified Data.Text.Lazy.Encoding as T (decodeUtf8) 18 | import Network.HTTP.Types.Status (seeOther303) 19 | import Data.Conduit (($$)) 20 | import Control.Monad.Trans.Resource (runResourceT) 21 | import Text.Julius 22 | 23 | getReportsR :: Handler Html 24 | getReportsR = do 25 | reports <- getAllReports 26 | defaultLayout $ do 27 | setTitle "TKYProf Reports" 28 | $(widgetFile "reports") 29 | 30 | postReportsR :: Handler () 31 | postReportsR = do 32 | files <- getPostedReports 33 | case files of 34 | [fileInfo] -> do reportId <- postFileInfo fileInfo 35 | sendResponseCreated $ ReportsIdR reportId 36 | _ -> do mapM_ postFileInfo files 37 | sendResponseCreated ReportsR 38 | 39 | getReportsIdR :: ReportID -> Handler Html 40 | getReportsIdR reportId = redirectWith seeOther303 (ReportsIdTimeR reportId []) 41 | 42 | getReportsIdTimeR :: ReportID -> [a] -> Handler Html 43 | getReportsIdTimeR reportId _ = getReportsIdCommon reportId "time" 44 | 45 | getReportsIdAllocR :: ReportID -> [a] -> Handler Html 46 | getReportsIdAllocR reportId _ = getReportsIdCommon reportId "alloc" 47 | 48 | -- Helper functions 49 | getPostedReports :: Handler [FileInfo] 50 | getPostedReports = do 51 | (_, files) <- runRequestBody 52 | case [ file | (header, file) <- files, header == "reports" ] of 53 | [] -> invalidArgs ["Missing files"] 54 | found -> return found 55 | 56 | postFileInfo :: FileInfo -> Handler ReportID 57 | postFileInfo info = do 58 | prof <- runResourceT $ lift $ (fileSource info) $$ profilingReportI 59 | postProfilingReport prof 60 | 61 | getReportsIdCommon :: ReportID -> Text -> Handler Html 62 | getReportsIdCommon reportId profilingType = do 63 | report@ProfilingReport {..} <- getProfilingReport reportId 64 | let json = rawJS $ T.decodeUtf8 $ A.encode reportCostCentres 65 | defaultLayout $ do 66 | setTitle $ "TKYProf Reports" 67 | addScript $ StaticR js_tkyprof_js 68 | addScript $ StaticR js_d3_min_js 69 | addScript $ StaticR js_d3_layout_min_js 70 | $(widgetFile "reports-id") 71 | -------------------------------------------------------------------------------- /Handler/Reports/Helpers.hs: -------------------------------------------------------------------------------- 1 | module Handler.Reports.Helpers 2 | ( runReports 3 | , getReports' 4 | , getAllReports 5 | , getAllProfilingReports 6 | , getProfilingReport 7 | , postProfilingReport 8 | ) where 9 | 10 | import Control.Applicative 11 | import Control.Monad.STM (STM, atomically) 12 | import Control.Monad.Trans (liftIO) 13 | import Model (Reports(..), ReportID, allReports, lookupReport, insertReport) 14 | import ProfilingReport (ProfilingReport) 15 | import TKYProf (Handler, TKYProf(getReports)) 16 | import Yesod.Core (getYesod) 17 | import Yesod.Core.Handler (notFound) 18 | 19 | runReports :: STM a -> Handler a 20 | runReports = liftIO . atomically 21 | 22 | getReports' :: Handler Reports 23 | getReports' = getReports <$> getYesod 24 | 25 | getAllReports :: Handler [(ReportID, ProfilingReport)] 26 | getAllReports = do 27 | rs <- getReports' 28 | runReports $ allReports rs 29 | 30 | getAllProfilingReports :: Handler [ProfilingReport] 31 | getAllProfilingReports = map snd <$> getAllReports 32 | 33 | getProfilingReport :: ReportID -> Handler ProfilingReport 34 | getProfilingReport reportId = do 35 | rs <- getReports' 36 | mreport <- runReports $ lookupReport reportId rs 37 | case mreport of 38 | Just r -> return r 39 | Nothing -> notFound 40 | 41 | postProfilingReport :: ProfilingReport -> Handler ReportID 42 | postProfilingReport prof = do 43 | rs <- getReports' 44 | runReports $ insertReport prof rs 45 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The following license covers this documentation, and the source code, except 2 | where otherwise indicated. 3 | 4 | Copyright 2011, Mitsutoshi Aoe. All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, this 10 | list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above copyright notice, 13 | this list of conditions and the following disclaimer in the documentation 14 | and/or other materials provided with the distribution. 15 | 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR 17 | IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 18 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO 19 | EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, 20 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 21 | NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, 22 | OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 23 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE 24 | OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF 25 | ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 26 | -------------------------------------------------------------------------------- /Model.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards #-} 2 | module Model where 3 | import Control.Applicative 4 | import Control.Concurrent.STM (STM, TVar, newTVar, readTVar, writeTVar) 5 | import Data.Map (Map) 6 | import ProfilingReport (ProfilingReport(..)) 7 | import qualified Data.Map as M 8 | 9 | type ReportID = Integer 10 | 11 | data Reports = Reports 12 | { newReportId :: TVar ReportID 13 | , reports :: TVar (Map ReportID ProfilingReport) 14 | } 15 | 16 | emptyReports :: STM Reports 17 | emptyReports = do 18 | uid <- newTVar 0 19 | rs <- newTVar M.empty 20 | return $ Reports { newReportId = uid 21 | , reports = rs } 22 | 23 | insertReport :: ProfilingReport -> Reports -> STM ReportID 24 | insertReport r Reports{..} = do 25 | uid <- readTVar newReportId 26 | rs <- readTVar reports 27 | writeTVar newReportId (succ uid) 28 | writeTVar reports (M.insert uid r rs) 29 | return uid 30 | 31 | deleteReport :: ReportID -> Reports -> STM () 32 | deleteReport i Reports{..} = do 33 | rs <- readTVar reports 34 | writeTVar reports (M.delete i rs) 35 | 36 | lookupReport :: ReportID -> Reports -> STM (Maybe ProfilingReport) 37 | lookupReport i Reports{..} = do 38 | rs <- readTVar reports 39 | return $ M.lookup i rs 40 | 41 | memberReport :: ReportID -> Reports -> STM Bool 42 | memberReport i Reports{..} = do 43 | rs <- readTVar reports 44 | return $ M.member i rs 45 | 46 | allReports :: Reports -> STM [(ReportID, ProfilingReport)] 47 | allReports (Reports _ rs) = M.toList <$> readTVar rs 48 | 49 | allProfilingReports :: Reports -> STM [ProfilingReport] 50 | allProfilingReports r = map snd <$> allReports r 51 | -------------------------------------------------------------------------------- /ProfilingReport.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances, RecordWildCards, OverloadedStrings, BangPatterns #-} 2 | {-# OPTIONS_GHC -fno-warn-unused-do-bind #-} 3 | module ProfilingReport 4 | ( -- * Parsers for profiling reports 5 | profilingReport 6 | , profilingReportI 7 | -- * Parsers for sub-parts of the report 8 | , timestamp 9 | , title 10 | , commandLine 11 | , totalTime 12 | , totalAlloc 13 | , hotCostCentres 14 | , costCentres 15 | -- * Data types 16 | , ProfilingReport(..) 17 | , Timestamp 18 | , CommandLine 19 | , TotalTime(..) 20 | , TotalAlloc(..) 21 | , BriefCostCentre(..) 22 | , CostCentre(..) 23 | -- * Re-exported modules 24 | , module Data.Tree 25 | ) where 26 | 27 | import Control.Applicative hiding (many) 28 | import Control.Monad.Catch (MonadThrow(..)) 29 | import Data.Aeson 30 | import Data.Attoparsec.Char8 as A8 31 | import Data.Conduit.Attoparsec (sinkParser) 32 | import Data.ByteString (ByteString) 33 | import Data.Conduit 34 | import Data.Foldable (asum, foldl') 35 | import Data.Time (UTCTime(..), TimeOfDay(..), timeOfDayToTime, fromGregorian) 36 | import Data.Tree (Tree(..), Forest) 37 | import Data.Tree.Zipper (TreePos, Full) 38 | import Prelude hiding (takeWhile) 39 | import qualified Data.Attoparsec as A 40 | import qualified Data.HashMap.Strict as M 41 | import qualified Data.Tree.Zipper as Z 42 | import qualified Data.Vector as V 43 | import Data.Text (Text) 44 | import qualified Data.Text.Encoding as T 45 | 46 | data ProfilingReport = ProfilingReport 47 | { reportTimestamp :: Timestamp 48 | , reportCommandLine :: CommandLine 49 | , reportTotalTime :: TotalTime 50 | , reportTotalAlloc :: TotalAlloc 51 | , reportHotCostCentres :: [BriefCostCentre] 52 | , reportCostCentres :: Tree CostCentre 53 | } deriving Show 54 | 55 | type Timestamp = UTCTime 56 | 57 | type CommandLine = Text 58 | 59 | data TotalTime = TotalTime 60 | { totalSecs :: Double 61 | , totalTicks :: Integer 62 | , resolution :: Integer 63 | , processors :: Integer 64 | } deriving Show 65 | 66 | newtype TotalAlloc = TotalAlloc 67 | { totalAllocBytes :: Integer 68 | } deriving Show 69 | 70 | data BriefCostCentre = BriefCostCentre 71 | { briefCostCentreName :: Text 72 | , briefCostCentreModule :: Text 73 | , briefCostCentreTime :: Double 74 | , briefCostCentreAlloc :: Double 75 | } deriving Show 76 | 77 | data CostCentre = CostCentre 78 | { costCentreName :: Text 79 | , costCentreModule :: Text 80 | , costCentreNo :: Integer 81 | , costCentreEntries :: Integer 82 | , individualTime :: Double 83 | , individualAlloc :: Double 84 | , inheritedTime :: Double 85 | , inheritedAlloc :: Double 86 | } deriving Show 87 | 88 | profilingReportI :: MonadThrow m => Sink ByteString m ProfilingReport 89 | profilingReportI = sinkParser profilingReport 90 | 91 | profilingReport :: Parser ProfilingReport 92 | profilingReport = spaces >> 93 | ProfilingReport <$> timestamp 94 | <* title <* spaces 95 | <*> commandLine <* spaces 96 | <*> totalTime <* spaces 97 | <*> totalAlloc <* spaces 98 | <*> hotCostCentres <* spaces 99 | <*> costCentres 100 | 101 | timestamp :: Parser Timestamp 102 | timestamp = do 103 | dayOfTheWeek <* spaces 104 | m <- month <* spaces 105 | d <- day <* spaces 106 | tod <- timeOfDay <* spaces 107 | y <- year <* spaces 108 | return UTCTime { utctDay = fromGregorian y m d 109 | , utctDayTime = timeOfDayToTime tod } 110 | where 111 | year = decimal 112 | month = toNum <$> A8.take 3 113 | where toNum m = case m of 114 | "Jan" -> 1; "Feb" -> 2; "Mar" -> 3; "Apr" -> 4; 115 | "May" -> 5; "Jun" -> 6; "Jul" -> 7; "Aug" -> 8; 116 | "Sep" -> 9; "Oct" -> 10; "Nov" -> 11; "Dec" -> 12 117 | _ -> error "timestamp.toNum: impossible" 118 | day = decimal 119 | timeOfDay = TimeOfDay <$> decimal <* string ":" <*> decimal <*> pure 0 120 | dayOfTheWeek = takeTill isSpace 121 | 122 | title :: Parser ByteString 123 | title = string "Time and Allocation Profiling Report (Final)" 124 | 125 | commandLine :: Parser CommandLine 126 | commandLine = T.decodeUtf8 <$> line 127 | 128 | totalTime :: Parser TotalTime 129 | totalTime = do 130 | string "total time ="; spaces 131 | secs <- double 132 | string " secs"; spaces 133 | (ticks, res, procs) <- parens $ (,,) 134 | <$> decimal <* string " ticks @ " 135 | <*> time <* string ", " 136 | <*> decimal <* many1 (notChar ')') 137 | return TotalTime { totalSecs = secs 138 | , totalTicks = ticks 139 | , resolution = res 140 | , processors = procs } 141 | where 142 | time = asum 143 | [ decimal <* string " us" 144 | , pure (*1000) <*> decimal <* string " ms" 145 | ] 146 | 147 | totalAlloc :: Parser TotalAlloc 148 | totalAlloc = do 149 | string "total alloc ="; spaces 150 | n <- groupedDecimal 151 | string " bytes" <* spaces <* parens (string "excludes profiling overheads") 152 | return TotalAlloc { totalAllocBytes = n } 153 | 154 | groupedDecimal :: Parser Integer 155 | groupedDecimal = foldl' go 0 <$> decimal `sepBy` char8 ',' 156 | where go z n = z*1000 + n 157 | 158 | hotCostCentres :: Parser [BriefCostCentre] 159 | hotCostCentres = header *> spaces *> many1 briefCostCentre 160 | where header :: Parser ByteString 161 | header = line 162 | 163 | briefCostCentre :: Parser BriefCostCentre 164 | briefCostCentre = 165 | BriefCostCentre <$> symbolText <* spaces 166 | <*> symbolText <* spaces 167 | <*> double <* spaces 168 | <*> double <* spaces 169 | 170 | costCentres :: Parser (Tree CostCentre) 171 | costCentres = header *> spaces *> costCentreTree 172 | where header = count 2 line 173 | 174 | -- Internal functions 175 | costCentreTree :: Parser (Tree CostCentre) 176 | costCentreTree = buildTree <$> costCentreMap >>= maybe empty pure 177 | where 178 | costCentreMap = nestedCostCentre `sepBy1` endOfLine 179 | nestedCostCentre = (,) <$> nestLevel <*> costCentre 180 | 181 | nestLevel :: Parser Int 182 | nestLevel = howMany space 183 | 184 | costCentre :: Parser CostCentre 185 | costCentre = 186 | CostCentre <$> (T.decodeUtf8 <$> takeWhile (not . isSpace)) <* spaces 187 | <*> (T.decodeUtf8 <$> takeWhile (not . isSpace)) <* spaces 188 | <*> decimal <* spaces 189 | <*> decimal <* spaces 190 | <*> double <* spaces 191 | <*> double <* spaces 192 | <*> double <* spaces 193 | <*> double 194 | 195 | type Zipper = TreePos Full 196 | type Level = Int 197 | 198 | buildTree :: [(Level, a)] -> Maybe (Tree a) 199 | buildTree [] = Nothing 200 | buildTree ((lvl, t):xs) = Z.toTree <$> snd (foldl' go (lvl, Just z) xs) 201 | where 202 | z = Z.fromTree $ Node t [] 203 | go :: (Level, Maybe (Zipper a)) -> (Level, a) -> (Level, Maybe (Zipper a)) 204 | go (curLvl, mzipper) a@(lvl', x) 205 | | curLvl > lvl' = go (curLvl-1, mzipper >>= Z.parent) a 206 | | curLvl < lvl' = case mzipper >>= Z.lastChild of 207 | Nothing -> (lvl', Z.insert (Node x []) . Z.children <$> mzipper) 208 | mzipper' -> go (curLvl+1, mzipper') a 209 | | otherwise = (lvl', Z.insert (Node x []) . Z.nextSpace <$> mzipper) 210 | 211 | 212 | -- Small utilities 213 | howMany :: Parser a -> Parser Int 214 | howMany p = howMany' 0 215 | where howMany' !n = (p >> howMany' (succ n)) <|> return n 216 | 217 | spaces :: Parser () 218 | spaces = () <$ skipMany space 219 | 220 | line :: Parser ByteString 221 | line = A.takeWhile (not . isEndOfLine) <* spaces 222 | 223 | parens :: Parser a -> Parser a 224 | parens p = string "(" *> p <* string ")" 225 | 226 | symbol :: Parser ByteString 227 | symbol = takeWhile (not . isSpace) 228 | 229 | symbolText :: Parser Text 230 | symbolText = T.decodeUtf8 <$> symbol 231 | 232 | -- Aeson 233 | instance ToJSON ProfilingReport where 234 | toJSON ProfilingReport {..} = 235 | object [ "timestamp" .= reportTimestamp 236 | , "commandLine" .= reportCommandLine 237 | , "totalTime" .= reportTotalTime 238 | , "totalAlloc" .= reportTotalAlloc 239 | , "hotCostCentres" .= reportHotCostCentres 240 | , "costCentres" .= reportCostCentres 241 | ] 242 | 243 | instance ToJSON TotalTime where 244 | toJSON TotalTime {..} = 245 | object [ "secs" .= totalSecs 246 | , "ticks" .= totalTicks 247 | , "resolution" .= resolution 248 | ] 249 | 250 | instance ToJSON TotalAlloc where 251 | toJSON TotalAlloc {..} = 252 | object [ "bytes" .= totalAllocBytes ] 253 | 254 | instance ToJSON BriefCostCentre where 255 | toJSON BriefCostCentre {..} = 256 | object [ "name" .= briefCostCentreName 257 | , "module" .= briefCostCentreModule 258 | , "time" .= briefCostCentreTime 259 | , "alloc" .= briefCostCentreAlloc 260 | ] 261 | 262 | instance ToJSON (Tree CostCentre) where 263 | toJSON (Node cc@(CostCentre {..}) subForest) 264 | | null subForest = cc' 265 | | otherwise = branch 266 | where 267 | branch = Object $ M.insert "subForest" subForestWithParent unwrappedCC 268 | parent = Object $ M.insert "isParent" (toJSON True) unwrappedCC 269 | subForestWithParent = Array $ V.fromList $ parent:map toJSON subForest 270 | cc'@(Object unwrappedCC) = toJSON cc 271 | 272 | instance ToJSON CostCentre where 273 | toJSON CostCentre {..} = 274 | object [ "name" .= costCentreName 275 | , "module" .= costCentreModule 276 | , "no" .= costCentreNo 277 | , "entries" .= costCentreEntries 278 | , "individualTime" .= individualTime 279 | , "individualAlloc" .= individualAlloc 280 | , "inheritedTime" .= inheritedTime 281 | , "inheritedAlloc" .= inheritedAlloc ] 282 | -------------------------------------------------------------------------------- /README.markdown: -------------------------------------------------------------------------------- 1 | TKYProf 2 | ======================== 3 | [![Build Status](https://travis-ci.org/maoe/tkyprof.png)](https://travis-ci.org/maoe/tkyprof) 4 | 5 | TKYProf is a web-based interactive visualizer for [GHC Time and Allocation Profiling Reports](http://www.haskell.org/ghc/dist/stable/docs/html/users_guide/prof-time-options.html). It helps you to find the performance bottlenecks of your code quickly. 6 | 7 | ![TKYProf](http://cdn-ak.f.st-hatena.com/images/fotolife/m/maoe/20110816/20110816185419.png) 8 | 9 | Prerequistes 10 | ------------------------ 11 | 12 | * TKYProf uses some of HTML5 features, but does not support graceful downgrading. You need a modern browser supporting HTML5 and CSS3 for now. 13 | * TKYProf is written in Haskell. Haskell Platform and Cabal are required. 14 | 15 | How to use TKYProf 16 | ------------------------ 17 | 18 | 1. `cabal install tkyprof` installs the executable `tkyprof`. 19 | 2. Run `tkyprof` on your terminal. 20 | 3. Access [http://localhost:3000/](http://localhost:3000/). 21 | 4. Drag and drop your profiling reports. 22 | 5. TKYProf draws a pretty chart. 23 | 24 | ![screenshot](http://cdn-ak.f.st-hatena.com/images/fotolife/m/maoe/20110817/20110817100841.png) 25 | 26 | Developers 27 | ------------------------ 28 | 29 | This tool is written and maintained by Mitsutoshi Aoe, . 30 | And thanks to the following contributors: 31 | 32 | * Ben Gamari (@bgamari) 33 | * Jasper Van der Jeugt (@jaspervdj) 34 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /TKYProf.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, OverloadedStrings, ViewPatterns #-} 2 | module TKYProf 3 | ( TKYProf (..) 4 | , Route (..) 5 | , resourcesTKYProf 6 | , Handler 7 | , Widget 8 | , module Yesod.Core 9 | , module Settings 10 | , module StaticFiles 11 | , module Model 12 | , module Control.Monad.STM 13 | , StaticRoute 14 | , lift 15 | ) where 16 | 17 | import Control.Monad (unless) 18 | import Control.Monad.STM (STM, atomically) 19 | import Control.Monad.Trans.Class (lift) 20 | import Model 21 | import Settings (hamletFile, luciusFile, juliusFile, widgetFile) 22 | import StaticFiles 23 | import System.Directory 24 | import System.FilePath (()) 25 | import Yesod.Core hiding (lift) 26 | import Yesod.Static 27 | import qualified Data.ByteString.Lazy as L 28 | import qualified Data.Text as T 29 | import qualified Settings 30 | 31 | -- | The site argument for your application. This can be a good place to 32 | -- keep settings and values requiring initialization before your application 33 | -- starts running, such as database connections. Every handler will have 34 | -- access to the data present here. 35 | data TKYProf = TKYProf 36 | { getStatic :: Static -- ^ Settings for static file serving. 37 | , getReports :: Reports 38 | } 39 | 40 | -- This is where we define all of the routes in our application. For a full 41 | -- explanation of the syntax, please see: 42 | -- http://docs.yesodweb.com/book/web-routes-quasi/ 43 | -- 44 | -- This function does three things: 45 | -- 46 | -- * Creates the route datatype TKYProfRoute. Every valid URL in your 47 | -- application can be represented as a value of this type. 48 | -- * Creates the associated type: 49 | -- type instance Route TKYProf = TKYProfRoute 50 | -- * Creates the value resourcesTKYProf which contains information on the 51 | -- resources declared below. This is used in Controller.hs by the call to 52 | -- mkYesodDispatch 53 | -- 54 | -- What this function does *not* do is create a YesodSite instance for 55 | -- TKYProf. Creating that instance requires all of the handler functions 56 | -- for our application to be in scope. However, the handler functions 57 | -- usually require access to the TKYProfRoute datatype. Therefore, we 58 | -- split these actions into two functions and place them in separate files. 59 | mkYesodData "TKYProf" $(parseRoutesFile "config/routes") 60 | 61 | -- Please see the documentation for the Yesod typeclass. There are a number 62 | -- of settings which can be configured by overriding methods here. 63 | instance Yesod TKYProf where 64 | approot = ApprootRelative 65 | 66 | defaultLayout widget = do 67 | mmsg <- getMessage 68 | (title, bcs) <- breadcrumbs 69 | pc <- widgetToPageContent $ do 70 | $(Settings.widgetFile "header") 71 | widget 72 | toWidget $(Settings.luciusFile "templates/default-layout.lucius") 73 | withUrlRenderer $(Settings.hamletFile "templates/default-layout.hamlet") 74 | 75 | -- This function creates static content files in the static folder 76 | -- and names them based on a hash of their content. This allows 77 | -- expiration dates to be set far in the future without worry of 78 | -- users receiving stale content. 79 | addStaticContent ext' _ content = do 80 | let fn = base64md5 content ++ '.' : T.unpack ext' 81 | let statictmp = Settings.staticdir "tmp/" 82 | liftIO $ createDirectoryIfMissing True statictmp 83 | let fn' = statictmp ++ fn 84 | exists <- liftIO $ doesFileExist fn' 85 | unless exists $ liftIO $ L.writeFile fn' content 86 | return $ Just $ Right (StaticR $ StaticRoute ["tmp", T.pack fn] [], []) 87 | 88 | maximumContentLength _ _ = Just $ 20*1024*1024 89 | 90 | instance YesodBreadcrumbs TKYProf where 91 | breadcrumb HomeR = return ("Home", Nothing) 92 | breadcrumb ReportsR = return ("Reports", Just HomeR) 93 | breadcrumb (ReportsIdTimeR rid _) = return ("Report #" `T.append` T.pack (show rid), Just ReportsR) 94 | breadcrumb (ReportsIdAllocR rid _) = return ("Report #" `T.append` T.pack (show rid), Just ReportsR) 95 | breadcrumb _ = return ("Not found", Just HomeR) 96 | -------------------------------------------------------------------------------- /bin/prof2json.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | import Blaze.ByteString.Builder (toByteStringIO) 3 | import Control.Applicative 4 | import Control.Exception (bracket) 5 | import Control.Monad.Trans (liftIO) 6 | import Data.Aeson (toJSON) 7 | import Data.Aeson.Encode (fromValue) 8 | import Data.Enumerator (Iteratee, ($$), run_) 9 | import ProfilingReport (ProfilingReport(..), profilingReportI) 10 | import System.Environment (getArgs) 11 | import System.FilePath (dropExtension) 12 | import System.IO (IOMode(WriteMode), openFile, hClose) 13 | import qualified Data.ByteString as S 14 | import qualified Data.Enumerator.Binary as E 15 | 16 | main :: IO () 17 | main = getArgs >>= mapM_ (run_ . job) 18 | 19 | job :: FilePath -> Iteratee S.ByteString IO () 20 | job f = E.enumFile f $$ iterJob json 21 | where 22 | json = dropExtension f ++ ".json" 23 | 24 | iterJob :: FilePath -> Iteratee S.ByteString IO () 25 | iterJob fpath = do 26 | builder <- fromValue . toJSON . reportCostCentres <$> profilingReportI 27 | liftIO $ bracket (openFile fpath WriteMode) 28 | hClose 29 | (\h -> toByteStringIO (S.hPut h) builder) 30 | -------------------------------------------------------------------------------- /bin/tkyprof.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable, CPP #-} 2 | import Controller (withTKYProf) 3 | import System.IO (hPutStrLn, stderr) 4 | 5 | #if PRODUCTION 6 | import Data.Version (showVersion) 7 | import Network.Wai.Handler.Warp (Port, run) 8 | import Paths_tkyprof (getDataDir, version) 9 | import System.Console.CmdArgs 10 | import System.Directory (setCurrentDirectory) 11 | 12 | main :: IO () 13 | main = do 14 | getDataDir >>= setCurrentDirectory 15 | TKYProfArg p <- cmdArgs tkyProfArg 16 | hPutStrLn stderr $ "TKYProf " ++ showVersion version ++ " launched, listening on http://localhost:" ++ show p ++ "/" 17 | withTKYProf $ run p 18 | 19 | data TKYProfArg = TKYProfArg 20 | { port :: Port 21 | } deriving (Show, Data, Typeable) 22 | 23 | tkyProfArg :: TKYProfArg 24 | tkyProfArg = TKYProfArg { port = 3000 &= help "Port number" } 25 | &= summary ("TKYProf " ++ showVersion version) 26 | #else 27 | import Network.Wai.Middleware.Debug (debug) 28 | import Network.Wai.Handler.Warp (run) 29 | 30 | main :: IO () 31 | main = do 32 | let port = 3000 33 | hPutStrLn stderr $ "Application launched, listening on port " ++ show port 34 | withTKYProf $ run port . debug 35 | #endif 36 | 37 | {- 38 | import Network.Wai.Handler.Webkit (run) 39 | 40 | main :: IO () 41 | main = withTKYProf $ run "TKYProf" 42 | -} 43 | -------------------------------------------------------------------------------- /config/Settings.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | -- | Settings are centralized, as much as possible, into this file. This 5 | -- includes database connection settings, static file locations, etc. 6 | -- In addition, you can configure a number of different aspects of Yesod 7 | -- by overriding methods in the Yesod typeclass. That instance is 8 | -- declared in the tkyprof.hs file. 9 | module Settings 10 | ( H.hamletFile 11 | , H.juliusFile 12 | , H.luciusFile 13 | , widgetFile 14 | , staticdir 15 | ) where 16 | 17 | import qualified Text.Hamlet as H 18 | import qualified Text.Julius as H 19 | import qualified Text.Lucius as H 20 | import Language.Haskell.TH.Syntax 21 | import Yesod.Default.Util 22 | import Data.Default (def) 23 | 24 | -- | The location of static files on your system. This is a file system 25 | -- path. The default value works properly with your scaffolded site. 26 | staticdir :: FilePath 27 | staticdir = "static" 28 | 29 | -- The rest of this file contains settings which rarely need changing by a 30 | -- user. 31 | 32 | -- The following three functions are used for calling HTML, CSS and 33 | -- Javascript templates from your Haskell code. During development, 34 | -- the "Debug" versions of these functions are used so that changes to 35 | -- the templates are immediately reflected in an already running 36 | -- application. When making a production compile, the non-debug version 37 | -- is used for increased performance. 38 | -- 39 | -- You can see an example of how to call these functions in Handler/Root.hs 40 | -- 41 | -- Note: due to polymorphic Hamlet templates, hamletFileDebug is no longer 42 | -- used; to get the same auto-loading effect, it is recommended that you 43 | -- use the devel server. 44 | 45 | widgetFile :: FilePath -> Q Exp 46 | widgetFile = widgetFileNoReload def 47 | -------------------------------------------------------------------------------- /config/StaticFiles.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, OverloadedStrings #-} 2 | module StaticFiles where 3 | 4 | import Yesod.Static 5 | 6 | -- | This generates easy references to files in the static directory at compile time. 7 | -- The upside to this is that you have compile-time verification that referenced files 8 | -- exist. However, any files added to your static directory during run-time can't be 9 | -- accessed this way. You'll have to use their FilePath or URL to access them. 10 | staticFiles "static" 11 | -------------------------------------------------------------------------------- /config/favicon.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maoe/tkyprof/82194cdb2bcfcd33820794fca9e8c07212050a94/config/favicon.png -------------------------------------------------------------------------------- /config/routes: -------------------------------------------------------------------------------- 1 | / HomeR GET 2 | /reports ReportsR GET POST 3 | /reports/#Integer ReportsIdR GET 4 | /reports/#Integer/time/*Texts ReportsIdTimeR GET 5 | /reports/#Integer/alloc/*Texts ReportsIdAllocR GET 6 | /static StaticR Static getStatic 7 | /favicon.png FaviconR GET 8 | /robots.txt RobotsR GET 9 | -------------------------------------------------------------------------------- /materials/snail-black.svgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maoe/tkyprof/82194cdb2bcfcd33820794fca9e8c07212050a94/materials/snail-black.svgz -------------------------------------------------------------------------------- /materials/snail.svgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maoe/tkyprof/82194cdb2bcfcd33820794fca9e8c07212050a94/materials/snail.svgz -------------------------------------------------------------------------------- /static/images/tkyprof-logo-orange.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maoe/tkyprof/82194cdb2bcfcd33820794fca9e8c07212050a94/static/images/tkyprof-logo-orange.png -------------------------------------------------------------------------------- /static/js/d3.layout.min.js: -------------------------------------------------------------------------------- 1 | ../../modules/d3/d3.layout.min.js -------------------------------------------------------------------------------- /static/js/d3.min.js: -------------------------------------------------------------------------------- 1 | ../../modules/d3/d3.min.js -------------------------------------------------------------------------------- /static/js/jquery.fileupload.js: -------------------------------------------------------------------------------- 1 | ../../modules/jQuery-File-Upload/jquery.fileupload.js -------------------------------------------------------------------------------- /static/js/jquery.iframe-transport.js: -------------------------------------------------------------------------------- 1 | ../../modules/jQuery-File-Upload/jquery.iframe-transport.js -------------------------------------------------------------------------------- /static/js/jquery.pjax.js: -------------------------------------------------------------------------------- 1 | // jquery.pjax.js 2 | // copyright chris wanstrath 3 | // https://github.com/defunkt/jquery-pjax 4 | 5 | (function($){ 6 | 7 | // When called on a link, fetches the href with ajax into the 8 | // container specified as the first parameter or with the data-pjax 9 | // attribute on the link itself. 10 | // 11 | // Tries to make sure the back button and ctrl+click work the way 12 | // you'd expect. 13 | // 14 | // Accepts a jQuery ajax options object that may include these 15 | // pjax specific options: 16 | // 17 | // container - Where to stick the response body. Usually a String selector. 18 | // $(container).html(xhr.responseBody) 19 | // push - Whether to pushState the URL. Defaults to true (of course). 20 | // replace - Want to use replaceState instead? That's cool. 21 | // 22 | // For convenience the first parameter can be either the container or 23 | // the options object. 24 | // 25 | // Returns the jQuery object 26 | $.fn.pjax = function( container, options ) { 27 | if ( options ) 28 | options.container = container 29 | else 30 | options = $.isPlainObject(container) ? container : {container:container} 31 | 32 | // We can't persist $objects using the history API so we must use 33 | // a String selector. Bail if we got anything else. 34 | if ( options.container && typeof options.container !== 'string' ) { 35 | throw "pjax container must be a string selector!" 36 | return false 37 | } 38 | 39 | return this.live('click', function(event){ 40 | // Middle click, cmd click, and ctrl click should open 41 | // links in a new tab as normal. 42 | if ( event.which > 1 || event.metaKey ) 43 | return true 44 | 45 | var defaults = { 46 | url: this.href, 47 | container: $(this).attr('data-pjax'), 48 | clickedElement: $(this), 49 | fragment: null 50 | } 51 | 52 | $.pjax($.extend({}, defaults, options)) 53 | 54 | event.preventDefault() 55 | }) 56 | } 57 | 58 | 59 | // Loads a URL with ajax, puts the response body inside a container, 60 | // then pushState()'s the loaded URL. 61 | // 62 | // Works just like $.ajax in that it accepts a jQuery ajax 63 | // settings object (with keys like url, type, data, etc). 64 | // 65 | // Accepts these extra keys: 66 | // 67 | // container - Where to stick the response body. Must be a String. 68 | // $(container).html(xhr.responseBody) 69 | // push - Whether to pushState the URL. Defaults to true (of course). 70 | // replace - Want to use replaceState instead? That's cool. 71 | // 72 | // Use it just like $.ajax: 73 | // 74 | // var xhr = $.pjax({ url: this.href, container: '#main' }) 75 | // console.log( xhr.readyState ) 76 | // 77 | // Returns whatever $.ajax returns. 78 | $.pjax = function( options ) { 79 | var $container = $(options.container), 80 | success = options.success || $.noop 81 | 82 | // We don't want to let anyone override our success handler. 83 | delete options.success 84 | 85 | // We can't persist $objects using the history API so we must use 86 | // a String selector. Bail if we got anything else. 87 | if ( typeof options.container !== 'string' ) 88 | throw "pjax container must be a string selector!" 89 | 90 | var defaults = { 91 | timeout: 650, 92 | push: true, 93 | replace: false, 94 | // We want the browser to maintain two separate internal caches: one for 95 | // pjax'd partial page loads and one for normal page loads. Without 96 | // adding this secret parameter, some browsers will often confuse the two. 97 | data: { _pjax: true }, 98 | type: 'GET', 99 | dataType: 'html', 100 | beforeSend: function(xhr){ 101 | $container.trigger('start.pjax') 102 | xhr.setRequestHeader('X-PJAX', 'true') 103 | }, 104 | error: function(){ 105 | window.location = options.url 106 | }, 107 | complete: function(){ 108 | $container.trigger('end.pjax') 109 | }, 110 | success: function(data){ 111 | if ( options.fragment ) { 112 | // If they specified a fragment, look for it in the response 113 | // and pull it out. 114 | var $fragment = $(data).find(options.fragment) 115 | if ( $fragment.length ) 116 | data = $fragment.children() 117 | else 118 | return window.location = options.url 119 | } else { 120 | // If we got no data or an entire web page, go directly 121 | // to the page and let normal error handling happen. 122 | if ( !$.trim(data) || / tag in the response, use it as 130 | // the page's title. 131 | var oldTitle = document.title, 132 | title = $.trim( $container.find('title').remove().text() ) 133 | if ( title ) document.title = title 134 | 135 | var state = { 136 | pjax: options.container, 137 | fragment: options.fragment, 138 | timeout: options.timeout 139 | } 140 | 141 | // If there are extra params, save the complete URL in the state object 142 | var query = $.param(options.data) 143 | if ( query != "_pjax=true" ) 144 | state.url = options.url + (/\?/.test(options.url) ? "&" : "?") + query 145 | 146 | if ( options.replace ) { 147 | window.history.replaceState(state, document.title, options.url) 148 | } else if ( options.push ) { 149 | // this extra replaceState before first push ensures good back 150 | // button behavior 151 | if ( !$.pjax.active ) { 152 | window.history.replaceState($.extend({}, state, {url:null}), oldTitle) 153 | $.pjax.active = true 154 | } 155 | 156 | window.history.pushState(state, document.title, options.url) 157 | } 158 | 159 | // Google Analytics support 160 | if ( (options.replace || options.push) && window._gaq ) 161 | _gaq.push(['_trackPageview']) 162 | 163 | // If the URL has a hash in it, make sure the browser 164 | // knows to navigate to the hash. 165 | var hash = window.location.hash.toString() 166 | if ( hash !== '' ) { 167 | window.location.href = hash 168 | } 169 | 170 | // Invoke their success handler if they gave us one. 171 | success.apply(this, arguments) 172 | } 173 | } 174 | 175 | options = $.extend(true, {}, defaults, options) 176 | 177 | if ( $.isFunction(options.url) ) { 178 | options.url = options.url() 179 | } 180 | 181 | // Cancel the current request if we're already pjaxing 182 | var xhr = $.pjax.xhr 183 | if ( xhr && xhr.readyState < 4) { 184 | xhr.onreadystatechange = $.noop 185 | xhr.abort() 186 | } 187 | 188 | $.pjax.xhr = $.ajax(options) 189 | $(document).trigger('pjax', $.pjax.xhr, options) 190 | 191 | return $.pjax.xhr 192 | } 193 | 194 | 195 | // Used to detect initial (useless) popstate. 196 | // If history.state exists, assume browser isn't going to fire initial popstate. 197 | var popped = ('state' in window.history), initialURL = location.href 198 | 199 | 200 | // popstate handler takes care of the back and forward buttons 201 | // 202 | // You probably shouldn't use pjax on pages with other pushState 203 | // stuff yet. 204 | $(window).bind('popstate', function(event){ 205 | // Ignore inital popstate that some browsers fire on page load 206 | var initialPop = !popped && location.href == initialURL 207 | popped = true 208 | if ( initialPop ) return 209 | 210 | var state = event.state 211 | 212 | if ( state && state.pjax ) { 213 | var container = state.pjax 214 | if ( $(container+'').length ) 215 | $.pjax({ 216 | url: state.url || location.href, 217 | fragment: state.fragment, 218 | container: container, 219 | push: false, 220 | timeout: state.timeout 221 | }) 222 | else 223 | window.location = location.href 224 | } 225 | }) 226 | 227 | 228 | // Add the state property to jQuery's event object so we can use it in 229 | // $(window).bind('popstate') 230 | if ( $.inArray('state', $.event.props) < 0 ) 231 | $.event.props.push('state') 232 | 233 | 234 | // Is pjax supported by this browser? 235 | $.support.pjax = 236 | window.history && window.history.pushState && window.history.replaceState 237 | // pushState isn't reliable on iOS yet. 238 | && !navigator.userAgent.match(/(iPod|iPhone|iPad|WebApps\/.+CFNetwork)/) 239 | 240 | 241 | // Fall back to normalcy for older browsers. 242 | if ( !$.support.pjax ) { 243 | $.pjax = function( options ) { 244 | window.location = $.isFunction(options.url) ? options.url() : options.url 245 | } 246 | $.fn.pjax = function() { return this } 247 | } 248 | 249 | })(jQuery); 250 | -------------------------------------------------------------------------------- /static/js/jquery.ui.widget.js: -------------------------------------------------------------------------------- 1 | ../../modules/jquery-ui/ui/jquery.ui.widget.js -------------------------------------------------------------------------------- /static/js/tkyprof.js: -------------------------------------------------------------------------------- 1 | // Quoted by "JavsScrpt: The Good Parts" 2 | 3 | Function.prototype.method = function(name, func) { 4 | if (!this.prototype[name]) { 5 | this.prototype[name] = func; 6 | return this; 7 | } 8 | } 9 | 10 | Function.method('curry', function() { 11 | var slice = Array.prototype.slice, 12 | args = slice.apply(arguments), 13 | that = this; 14 | return function() { 15 | return that.apply(null, args.concat(slice.apply(arguments))); 16 | }; 17 | }); 18 | 19 | Array.method('shift', function() { 20 | return this.splice(0, 1)[0]; 21 | }); 22 | 23 | Array.method('splice', function(start, deleteCount) { 24 | var max = Math.max, 25 | min = Math.min, 26 | delta, 27 | element, 28 | insertCount = max(arguments.length - 2, 0), 29 | k = 0, 30 | len = this.length, 31 | newLen, 32 | result = [], 33 | shiftCount; 34 | 35 | start = start || 0; 36 | if (start < 0) { 37 | start += len; 38 | } 39 | start = max(min(start, len), 0); 40 | deleteCount = max( 41 | min( 42 | typeof deleteCount === 'number' 43 | ? deleteCount 44 | : len, 45 | len - start 46 | ), 47 | 0 48 | ); 49 | delta = insertCount - deleteCount; 50 | newLen = len + delta; 51 | while (k < deleteCount) { 52 | element = this[start + k]; 53 | if (element !== undefined) { 54 | result[k] = element; 55 | } 56 | k += 1; 57 | } 58 | shiftCount = len - start - deleteCount; 59 | if (delta < 0) { 60 | k = start + insertCount; 61 | while (shiftCount) { 62 | this[k] = this[k - delta]; 63 | k += 1; 64 | shiftCount -= 1; 65 | } 66 | this.length = newLen; 67 | } else if (delta > 0) { 68 | k = 1; 69 | while (shiftCount) { 70 | this[newLen - k] = this[len - k]; 71 | k += 1; 72 | shiftCount -= 1; 73 | } 74 | } 75 | for (k = 0; k < insertCount; k += 1) { 76 | this[start + k] = arguments[k + 2]; 77 | } 78 | return result; 79 | }); 80 | 81 | Array.method('unshift', function() { 82 | this.splice.apply( 83 | this, 84 | [0, 0].concat(Array.prototype.slice.apply(arguments)) 85 | ); 86 | return this.length; 87 | }); 88 | -------------------------------------------------------------------------------- /templates/default-layout.hamlet: -------------------------------------------------------------------------------- 1 | !!! 2 | 3 | 4 | 5 | 6 | 7 |