diff options
| -rw-r--r-- | Main.hs | 61 | ||||
| -rw-r--r-- | comatose.cabal | 4 | ||||
| -rw-r--r-- | data/script.js | 29 | ||||
| -rw-r--r-- | data/style.css | 27 |
4 files changed, 107 insertions, 14 deletions
@@ -8,6 +8,8 @@ import Data.List (nub, sort, sortBy) import Data.Function (on) import Data.Maybe (catMaybes) import qualified Data.Text as T +import Data.Text.Encoding (decodeUtf8) +import qualified Data.Aeson as A import Text.BibTeX.Parse import Text.BibTeX.Entry as E import qualified Data.Map as M @@ -15,6 +17,7 @@ import Text.Parsec.Error import Text.ParserCombinators.Parsec.Prim import qualified Data.ByteString.Lazy as BS import System.FilePath ((<.>), splitExtension) +import System.Directory (copyFile) import Network.URI (isReserved, escapeURIString) import Lucid @@ -23,6 +26,7 @@ import Paths_comatose data Protocol = Protocol { pname :: String , plongname :: Maybe String + , pdescription :: Maybe String , pref :: [String] , pfeatures :: M.Map String (Maybe String) } deriving Show @@ -38,12 +42,26 @@ data Feature = Feature { , fdescription :: Maybe String } deriving Show +data JQData = JQData { + jname :: String + , jlongname :: Maybe String + , jdescription :: Maybe String + } deriving Show + +instance ToJSON JQData where + toJSON d = object [ + "name" .= jname d + , "longname" .= jlongname d + , "description" .= jdescription d + ] + type FeatureList = M.Map String Feature instance FromJSON Protocol where parseJSON (Object v) = Protocol <$> v .: "name" <*> v .:? "longname" + <*> v .:? "description" <*> v .:? "ref" .!= [] <*> v .:? "features" .!= M.empty parseJSON _ = mzero @@ -93,19 +111,29 @@ scholarSearch q = "http://scholar.google.com/scholar?q=" ++ escapeURIString isRe resolveDoi q = "http://doi.org/" ++ q protoentry :: Database -> (String, Protocol) -> Html () -protoentry db (ident, p) = tr_ [id_ $ T.pack ident] $ do +protoentry db (ident, p) = let pubs = protoPublications db p firstpub = join (head' pubs) field key = firstpub >>= (return . E.fields) >>= lookup key - td_ $ toHtml $ pname p - td_ $ maybeToHtml $ plongname p - td_ $ do - maybe "" (\x -> a_ [href_ $ T.pack $ resolveDoi x] "doi") $ field "doi" - " " - maybe "" (\x -> a_ [href_ $ T.pack $ scholarSearch x] "Google") $ field "title" - td_ $ maybeToHtml $ field "year" - td_ [class_ "features"] $ ul_ $ forM_ (sort $ M.keys $ pfeatures p) (\x -> li_ $ toHtml $ maybe ("" :: String) fname $ M.lookup x (dfeatures db)) + jdata = JQData { + jname = pname p + , jlongname = plongname p + , jdescription = pdescription p + } + in + tr_ [ + id_ $ T.pack ident + , data_ "proto" ((decodeUtf8 . BS.toStrict . A.encode) jdata) + ] $ do + td_ $ toHtml $ pname p + td_ $ maybeToHtml $ plongname p + td_ $ do + maybe "" (\x -> a_ [href_ $ T.pack $ resolveDoi x] "doi") $ field "doi" + " " + maybe "" (\x -> a_ [href_ $ T.pack $ scholarSearch x] "Google") $ field "title" + td_ $ maybeToHtml $ field "year" + td_ [class_ "features"] $ ul_ $ forM_ (sort $ M.keys $ pfeatures p) (\x -> li_ $ toHtml $ maybe ("" :: String) fname $ M.lookup x (dfeatures db)) extcss url = link_ [rel_ "stylesheet", type_ "text/css", href_ url] @@ -164,7 +192,7 @@ page db attrib = doctypehtml_ $ do extjs "https://cdn.datatables.net/1.10.5/js/jquery.dataTables.js" extcss "https://cdn.datatables.net/plug-ins/f2c75b7247b/integration/bootstrap/3/dataTables.bootstrap.css" extjs "https://cdn.datatables.net/plug-ins/f2c75b7247b/integration/bootstrap/3/dataTables.bootstrap.js" - style_ "td.features ul { list-style-type: none; margin: 0; padding: 0; }" + extcss "style.css" body_ $ do div_ [class_ "container"] $ do div_ [class_ "page-header"] $ do @@ -172,14 +200,23 @@ page db attrib = doctypehtml_ $ do introduction protocols db references (sortBy (compare `on` lookup "year" . E.fields) attrib) - script_ "$(document).ready( function () { $('#algo').DataTable( { paging: false, \"columnDefs\": [ ] } ); } );" + div_ [id_ "background"] "" + div_ [id_ "popup"] $ do + h2_ "" + p_ [class_ "subtitle"] "" + p_ [class_ "description"] "" + extjs "script.js" render f db attribution = renderToFile f (page db attribution) readAttributions = getDataFileName "data/attribution.bib" >>= parseFromFile file +copyDataFile source dest = getDataFileName source >>= (\x -> copyFile x dest) + main = do db <- getDataFileName "data/db.yaml" >>= readDb (Right attribution) <- readAttributions - render "comatose.html" db attribution + render "_build/index.html" db attribution + copyDataFile "data/style.css" "_build/style.css" + copyDataFile "data/script.js" "_build/script.js" diff --git a/comatose.cabal b/comatose.cabal index 2225a8c..3ff7a28 100644 --- a/comatose.cabal +++ b/comatose.cabal @@ -13,13 +13,13 @@ category: Web build-type: Simple -- extra-source-files: cabal-version: >=1.10 -data-files: data/db.yaml, data/db.bib, data/attribution.bib +data-files: data/db.yaml, data/db.bib, data/attribution.bib, data/script.js, data/style.css executable comatose main-is: Main.hs -- other-modules: -- other-extensions: - build-depends: base >=4.6 && <4.7, bibtex, yaml, containers, parsec, lucid, bytestring, text, filepath, network + build-depends: base >=4.6 && <4.7, bibtex, yaml, containers, parsec, lucid, bytestring, text, filepath, network, aeson, directory -- hs-source-dirs: default-language: Haskell2010 diff --git a/data/script.js b/data/script.js new file mode 100644 index 0000000..8ed1aa8 --- /dev/null +++ b/data/script.js @@ -0,0 +1,29 @@ +$(document).ready (function () { + $('#algo').DataTable ({ + paging: false, + "columnDefs": [], + }); + $('#algo tr').click (function () { + var data = $(this).data ('proto'); + $('#popup h2').text (data.name); + $('#popup .subtitle').text (data.longname); + $('#popup .year').text (data.year); + $('#popup .description').text (data.description); + + $('#popup').fadeIn ('normal'); + $('#background').fadeIn ('normal'); + }); + /* hide popup window */ + function hide () { + $('#popup').fadeOut ('normal'); + $('#background').fadeOut ('normal'); + } + $('#background').click (function () { + hide (); + }); + $(document).keyup (function (e) { + if (e.keyCode == 27) { + hide (); + } + }); +}); diff --git a/data/style.css b/data/style.css new file mode 100644 index 0000000..81b9190 --- /dev/null +++ b/data/style.css @@ -0,0 +1,27 @@ +td.features ul { + list-style-type: none; + margin: 0; + padding: 0; +} + +#popup { + display: none; + position: fixed; + background-color: #fff; + top: 25%; + left: 25%; + width: 50%; + padding: 2em; +} + +#background { + display: none; + position: fixed; + top: 0; + left: 0; + width: 100%; + height: 100%; + background-color: #000; + opacity: 0.5; +} + |