fix-symbols-gitit (empty) → 0.0.1

raw patch · 4 files changed

+114/−0 lines, 4 filesdep +basedep +gititsetup-changed

Dependencies added: base, gitit

Files

• COPYING +25/−0
• Setup.lhs +3/−0
• fix-symbols-gitit.cabal +23/−0
• src/Network/Gitit/Plugin/FixSymbols.hs +63/−0

@@ -0,0 +1,25 @@+Copyright (c) 2010 Conal Elliott+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. The names of the authors may not be used to endorse or promote products+   derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.+IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,23 @@+Name:                fix-symbols-gitit+Version:             0.0.1+Cabal-Version:       >= 1.2+Synopsis:            +Category:            Text+Description:+  Gitit plugin: Turn some Haskell symbols into pretty math symbols.+Author:              Conal Elliott+Maintainer:          conal@conal.net+Copyright:           (c) 2010 by Conal Elliott+License:             BSD3+License-File:        COPYING+Stability:           experimental+build-type:          Simple++Library+  hs-Source-Dirs:      src+  Extensions:+  Build-Depends:       base<5, gitit+  Exposed-Modules:     +                       Network.Gitit.Plugin.FixSymbols+                       +  ghc-options:         -Wall

@@ -0,0 +1,63 @@+-- {-# LANGUAGE #-}+{-# OPTIONS_GHC -Wall #-}+----------------------------------------------------------------------+-- |+-- Module      :  Network.Gitit.Plugin.FixSymbols+-- Copyright   :  (c) Conal Elliott 2010+-- License     :  BSD3+-- +-- Maintainer  :  conal@conal.net+-- Stability   :  experimental+-- +-- Turn some Haskell symbols into pretty math symbols+----------------------------------------------------------------------++module Network.Gitit.Plugin.FixSymbols (plugin) where++import Network.Gitit.Interface++import Data.List (isPrefixOf)++plugin :: Plugin+plugin = PageTransform $ return . processWith fixInline . processWith fixBlock++-- mkPageTransform :: Data a => (a -> a) -> Plugin+-- mkPageTransform fn = PageTransform $ return . processWith fn+++fixInline :: Inline -> Inline+fixInline (Code s) = Code (codeSubst s)+fixInline x        = x++fixBlock :: Block -> Block+fixBlock (CodeBlock attr@(_,classes,_) s)+  | "haskell" `elem` classes = CodeBlock attr (codeSubst s)+fixBlock x = x++-- TODO: transform lexemes instead of strings to avoid things like "-->"+-- becoming "-→".  Use the Text.Read.Lex module in Base.  Hm.  How to+-- reconstruct white space & comments?++codeSubst :: String -> String+codeSubst = substs [ ("forall","∀"),("->","→"),(":*","×")+                   , ("\\","λ")+                   , ("`lub`","⊔"),("`glb`","⊓"), ("lub","(⊔)"),("glb","(⊓)")+                   , ("undefined","⊥"), ("bottom","⊥")+                   , ("<-","←"), ("::","∷"), ("..","‥"), ("...","⋯")+                   ]++-- TODO: Faster substitution.  Turn the from/to pairs into a single, fast+-- automaton.  I could also switch to a single-pass algorithm, instead of+-- one pass per from/to pair.++subst :: String -> String -> String -> String+subst from to = sub+ where+   sub :: String -> String+   sub "" = ""+   sub str | from `isPrefixOf` str = to ++ sub (drop n str)+   sub (c:cs) = c : sub cs+   n = length from++substs :: [(String, String)] -> String -> String+substs = foldr (.) id . map (uncurry subst)