module Network.Gitit.Plugin.FixSymbols (plugin) where
import Network.Gitit.Interface
import Data.List (isPrefixOf)
plugin :: Plugin
plugin = PageTransform $ return . processWith fixInline . processWith fixBlock
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
codeSubst :: String -> String
codeSubst = substs [ ("forall","∀"),("->","→"),(":*","×")
, ("\\","λ")
, ("`lub`","⊔"),("`glb`","⊓"), ("lub","(⊔)"),("glb","(⊓)")
, ("undefined","⊥"), ("bottom","⊥")
, ("<-","←"), ("::","∷"), ("..","‥"), ("...","⋯")
]
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)