Browse Source

Style fixes

master
Alex Feldman-Crough 2 years ago
parent
commit
8d1517e024
  1. 25
      src/prosidy-manual/Prosidy/Manual/Compile.hs
  2. 52
      src/prosidy-manual/Prosidy/Manual/Highlight.hs
  3. 3
      src/prosidyc/Prosidy/Compile/Internal/Eval.hs

25
src/prosidy-manual/Prosidy/Manual/Compile.hs

@ -13,7 +13,7 @@ import Prosidy.Manual.Slug ( Slug(..)
, FileSlug(..)
, slug
)
import Prosidy.Manual.Highlight (highlight)
import Prosidy.Manual.Highlight ( highlight )
import Control.Lens.Operators
import Control.Applicative ( (<|>) )
@ -117,22 +117,27 @@ document = mdo
H.main body
H.footer $ do
H.div $ do
H.div ! HA.id "copyright" $
"Copyright ©2020 James Alexander Feldman-Crough."
H.div
! HA.id "copyright"
$ "Copyright ©2020 James Alexander Feldman-Crough."
H.div ! HA.id "license" $ do
"Released under the "
H.a "MPL-2.0 license"
! HA.href "https://www.mozilla.org/en-US/MPL/2.0/"
H.a "MPL-2.0 license" ! HA.href
"https://www.mozilla.org/en-US/MPL/2.0/"
"."
H.div ! HA.id "credits" $ do
"Our color scheme is "
H.a "Nord" ! HA.href "https://www.nordtheme.com/"
H.a "Nord"
! HA.href "https://www.nordtheme.com/"
"."
H.ul $ do
H.li $ H.a "Homepage" ! HA.href "https://prosidy.org"
H.li $ H.a "Source repository" ! HA.href "https://git.fldcr.com/prosidy"
H.li $ H.a "Contact us" ! HA.href "mailto:hello@prosidy.org"
H.li $ H.a "Homepage" ! HA.href
"https://prosidy.org"
H.li $ H.a "Source repository" ! HA.href
"https://git.fldcr.com/prosidy"
H.li $ H.a "Contact us" ! HA.href
"mailto:hello@prosidy.org"
blockTag :: C.ProductRule Block Manual H.Html -> Html BlockTag
blockTag blockRule = do

52
src/prosidy-manual/Prosidy/Manual/Highlight.hs

@ -1,30 +1,33 @@
{-# LANGUAGE OverloadedStrings #-}
module Prosidy.Manual.Highlight where
import qualified Skylighting.Core as S
import qualified Data.Map.Strict as Map
import System.IO.Unsafe (unsafePerformIO)
import Data.Text (Text)
import Text.Blaze.Html5 ((!), Html)
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as HA
import Data.Foldable (for_)
import Numeric.Natural (Natural)
import qualified Skylighting.Core as S
import qualified Data.Map.Strict as Map
import System.IO.Unsafe ( unsafePerformIO )
import Data.Text ( Text )
import Text.Blaze.Html5 ( (!)
, Html
)
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as HA
import Data.Foldable ( for_ )
import Numeric.Natural ( Natural )
highlight :: Text -> Text -> Html
highlight stxName src
| Just stx <- syntax stxName
, Right lines <- tokenize stx src
= for_ (zip [1..] lines) (uncurry renderLine)
| otherwise
= H.code $ H.text src
| Just stx <- syntax stxName, Right lines <- tokenize stx src = for_
(zip [1 ..] lines)
(uncurry renderLine)
| otherwise = H.code $ H.text src
renderLine :: Natural -> S.SourceLine -> Html
renderLine lno line = H.code
! H.dataAttribute "line-number" (H.toValue $ show lno)
! HA.class_ "source-line"
$ for_ line $ \(type_, token) ->
H.span (H.text token) ! H.dataAttribute "type" (tokenClass type_)
renderLine lno line =
H.code
! H.dataAttribute "line-number" (H.toValue $ show lno)
! HA.class_ "source-line"
$ for_ line
$ \(type_, token) ->
H.span (H.text token) ! H.dataAttribute "type" (tokenClass type_)
tokenClass :: S.TokenType -> H.AttributeValue
tokenClass S.KeywordTok = "keyword"
@ -60,10 +63,9 @@ tokenClass S.ErrorTok = "error"
tokenClass S.NormalTok = "normal"
tokenize :: S.Syntax -> Text -> Either String [S.SourceLine]
tokenize = S.tokenize S.TokenizerConfig
{ S.syntaxMap = syntaxMap
, S.traceOutput = False
}
tokenize = S.tokenize S.TokenizerConfig { S.syntaxMap = syntaxMap
, S.traceOutput = False
}
syntax :: Text -> Maybe S.Syntax
syntax = flip S.lookupSyntax syntaxMap
@ -75,9 +77,9 @@ formatOptions :: S.FormatOptions
formatOptions = S.defaultFormatOpts
prosidySyntax :: S.Syntax
prosidySyntax = unsafePerformIO $ do
prosidySyntax = unsafePerformIO $ do
result <- S.parseSyntaxDefinition "./kate/prosidy.xml"
either fail pure result
hex :: String -> Maybe S.Color
hex = S.toColor
hex = S.toColor

3
src/prosidyc/Prosidy/Compile/Internal/Eval.hs

@ -61,7 +61,8 @@ instance MonadTrans (Eval input) where
lift m = Eval $ \_ st -> fmap (\x -> (pure x, st)) m
instance Monad context => MonadFail (Eval input context) where
fail message = Eval $ \_ st -> pure (resultError . CustomError $ Text.pack message, st)
fail message =
Eval $ \_ st -> pure (resultError . CustomError $ Text.pack message, st)
-- | Keeps track of which properties and settings have been visited.
data EvalState = EvalState

Loading…
Cancel
Save