{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

module IHaskell.CSS (ihaskellCSS) where

import           Data.Text as T

ihaskellCSS :: Text
ihaskellCSS :: Text
ihaskellCSS =
  [Text] -> Text
T.unlines
    [
    Text
hoogleCSS
    , Text
basicCSS
    , Text
highlightCSS
    , Text
hlintCSS
    ]

hoogleCSS :: Text
hoogleCSS :: Text
hoogleCSS =
  [Text] -> Text
T.unlines
    [
    -- Custom IHaskell CSS
    Text
"/* Styles used for the Hoogle display in the pager */"
    , Text
".hoogle-doc {"
    , Text
"display: block;"
    , Text
"padding-bottom: 1.3em;"
    , Text
"padding-left: 0.4em;"
    , Text
"}"
    , Text
".hoogle-code {"
    , Text
"display: block;"
    , Text
"font-family: monospace;"
    , Text
"white-space: pre;"
    , Text
"}"
    , Text
".hoogle-text {"
    , Text
"display: block;"
    , Text
"}"
    , Text
".hoogle-name {"
    , Text
"color: green;"
    , Text
"font-weight: bold;"
    , Text
"}"
    , Text
".hoogle-head {"
    , Text
"font-weight: bold;"
    , Text
"}"
    , Text
".hoogle-sub {"
    , Text
"display: block;"
    , Text
"margin-left: 0.4em;"
    , Text
"}"
    , Text
".hoogle-package {"
    , Text
"font-weight: bold;"
    , Text
"font-style: italic;"
    , Text
"}"
    , Text
".hoogle-module {"
    , Text
"font-weight: bold;"
    , Text
"}"
    , Text
".hoogle-class {"
    , Text
"font-weight: bold;"
    , Text
"}"
    ]


basicCSS :: Text
basicCSS :: Text
basicCSS =
  [Text] -> Text
T.unlines
    [
    -- Styles used for basic displays
    Text
".get-type {"
    , Text
"color: green;"
    , Text
"font-weight: bold;"
    , Text
"font-family: monospace;"
    , Text
"display: block;"
    , Text
"white-space: pre-wrap;"
    , Text
"}"
    , Text
".show-type {"
    , Text
"color: green;"
    , Text
"font-weight: bold;"
    , Text
"font-family: monospace;"
    , Text
"margin-left: 1em;"
    , Text
"}"
    , Text
".mono {"
    , Text
"font-family: monospace;"
    , Text
"display: block;"
    , Text
"}"
    , Text
".err-msg {"
    , Text
"color: red;"
    , Text
"font-style: italic;"
    , Text
"font-family: monospace;"
    , Text
"white-space: pre;"
    , Text
"display: block;"
    , Text
"}"
    , Text
"#unshowable {"
    , Text
"color: red;"
    , Text
"font-weight: bold;"
    , Text
"}"
    , Text
".err-msg.in.collapse {"
    , Text
"padding-top: 0.7em;"
    , Text
"}"
    ]

highlightCSS :: Text
highlightCSS :: Text
highlightCSS =
  [Text] -> Text
T.unlines
    [
    -- Code that will get highlighted before it is highlighted
    Text
".highlight-code {"
    , Text
"white-space: pre;"
    , Text
"font-family: monospace;"
    , Text
"}"
    ]

hlintCSS :: Text
hlintCSS :: Text
hlintCSS =
  [Text] -> Text
T.unlines
    [
    Text
".suggestion-warning { "
    , Text
"font-weight: bold;"
    , Text
"color: rgb(200, 130, 0);"
    , Text
"}"
    , Text
".suggestion-error { "
    , Text
"font-weight: bold;"
    , Text
"color: red;"
    , Text
"}"
    , Text
".suggestion-name {"
    , Text
"font-weight: bold;"
    , Text
"}"
    ]