module Language.Haskell.HsColour (Output(..), ColourPrefs(..),
hscolour) where
import Language.Haskell.HsColour.Colourise (ColourPrefs(..))
import qualified Language.Haskell.HsColour.TTY as TTY
import qualified Language.Haskell.HsColour.HTML as HTML
import qualified Language.Haskell.HsColour.CSS as CSS
import qualified Language.Haskell.HsColour.ACSS as ACSS
import qualified Language.Haskell.HsColour.InlineCSS as ICSS
import qualified Language.Haskell.HsColour.LaTeX as LaTeX
import qualified Language.Haskell.HsColour.MIRC as MIRC
import Data.List(mapAccumL, isPrefixOf)
import Data.Maybe
import Language.Haskell.HsColour.Output
hscolour :: Output
-> ColourPrefs
-> Bool
-> Bool
-> String
-> Bool
-> String
-> String
hscolour :: Output
-> ColourPrefs
-> Bool
-> Bool
-> String
-> Bool
-> String
-> String
hscolour output :: Output
output pref :: ColourPrefs
pref anchor :: Bool
anchor partial :: Bool
partial title :: String
title False =
(if Bool
partial then String -> String
forall a. a -> a
id else Output -> String -> String -> String
top'n'tail Output
output String
title) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Output -> ColourPrefs -> Bool -> Int -> String -> String
hscolour' Output
output ColourPrefs
pref Bool
anchor 1
hscolour output :: Output
output pref :: ColourPrefs
pref anchor :: Bool
anchor partial :: Bool
partial title :: String
title True =
(if Bool
partial then String -> String
forall a. a -> a
id else Output -> String -> String -> String
top'n'tail Output
output String
title) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Lit] -> [String]
chunk 1 ([Lit] -> [String]) -> (String -> [Lit]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Lit] -> [Lit]
joinL ([Lit] -> [Lit]) -> (String -> [Lit]) -> String -> [Lit]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [Lit]
classify ([String] -> [Lit]) -> (String -> [String]) -> String -> [Lit]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
inlines
where
chunk :: Int -> [Lit] -> [String]
chunk _ [] = []
chunk n :: Int
n (Code c :: String
c: cs :: [Lit]
cs) = Output -> ColourPrefs -> Bool -> Int -> String -> String
hscolour' Output
output ColourPrefs
pref Bool
anchor Int
n String
c
String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> [Lit] -> [String]
chunk (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> [String]
lines String
c)) [Lit]
cs
chunk n :: Int
n (Lit c :: String
c: cs :: [Lit]
cs) = String
c String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> [Lit] -> [String]
chunk Int
n [Lit]
cs
hscolour' :: Output
-> ColourPrefs
-> Bool
-> Int
-> String
-> String
hscolour' :: Output -> ColourPrefs -> Bool -> Int -> String -> String
hscolour' TTY pref :: ColourPrefs
pref _ _ = ColourPrefs -> String -> String
TTY.hscolour ColourPrefs
pref
hscolour' (TTYg tt :: TerminalType
tt) pref :: ColourPrefs
pref _ _ = TerminalType -> ColourPrefs -> String -> String
TTY.hscolourG TerminalType
tt ColourPrefs
pref
hscolour' MIRC pref :: ColourPrefs
pref _ _ = ColourPrefs -> String -> String
MIRC.hscolour ColourPrefs
pref
hscolour' LaTeX pref :: ColourPrefs
pref _ _ = ColourPrefs -> String -> String
LaTeX.hscolour ColourPrefs
pref
hscolour' HTML pref :: ColourPrefs
pref anchor :: Bool
anchor n :: Int
n = ColourPrefs -> Bool -> Int -> String -> String
HTML.hscolour ColourPrefs
pref Bool
anchor Int
n
hscolour' CSS _ anchor :: Bool
anchor n :: Int
n = Bool -> Int -> String -> String
CSS.hscolour Bool
anchor Int
n
hscolour' ICSS pref :: ColourPrefs
pref anchor :: Bool
anchor n :: Int
n = ColourPrefs -> Bool -> Int -> String -> String
ICSS.hscolour ColourPrefs
pref Bool
anchor Int
n
hscolour' ACSS _ anchor :: Bool
anchor n :: Int
n = Bool -> Int -> String -> String
ACSS.hscolour Bool
anchor Int
n
top'n'tail :: Output
-> String
-> (String->String)
top'n'tail :: Output -> String -> String -> String
top'n'tail TTY _ = String -> String
forall a. a -> a
id
top'n'tail (TTYg _) _ = String -> String
forall a. a -> a
id
top'n'tail MIRC _ = String -> String
forall a. a -> a
id
top'n'tail LaTeX title :: String
title = String -> String -> String
LaTeX.top'n'tail String
title
top'n'tail HTML title :: String
title = String -> String -> String
HTML.top'n'tail String
title
top'n'tail CSS title :: String
title = String -> String -> String
CSS.top'n'tail String
title
top'n'tail ICSS title :: String
title = String -> String -> String
ICSS.top'n'tail String
title
top'n'tail ACSS title :: String
title = String -> String -> String
CSS.top'n'tail String
title
data Lit = Code {Lit -> String
unL :: String} | Lit {unL :: String} deriving (Int -> Lit -> String -> String
[Lit] -> String -> String
Lit -> String
(Int -> Lit -> String -> String)
-> (Lit -> String) -> ([Lit] -> String -> String) -> Show Lit
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Lit] -> String -> String
$cshowList :: [Lit] -> String -> String
show :: Lit -> String
$cshow :: Lit -> String
showsPrec :: Int -> Lit -> String -> String
$cshowsPrec :: Int -> Lit -> String -> String
Show)
inlines :: String -> [String]
inlines :: String -> [String]
inlines s :: String
s = String -> (String -> String) -> [String]
lines' String
s String -> String
forall a. a -> a
id
where
lines' :: String -> (String -> String) -> [String]
lines' [] acc :: String -> String
acc = [String -> String
acc []]
lines' ('\^M':'\n':s :: String
s) acc :: String -> String
acc = String -> String
acc ['\n'] String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> (String -> String) -> [String]
lines' String
s String -> String
forall a. a -> a
id
lines' ('\n':s :: String
s) acc :: String -> String
acc = String -> String
acc ['\n'] String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> (String -> String) -> [String]
lines' String
s String -> String
forall a. a -> a
id
lines' (c :: Char
c:s :: String
s) acc :: String -> String
acc = String -> (String -> String) -> [String]
lines' String
s (String -> String
acc (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:))
classify :: [String] -> [Lit]
classify :: [String] -> [Lit]
classify [] = []
classify (x :: String
x:xs :: [String]
xs) | "\\begin{code}"String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`String
x
= String -> Lit
Lit String
xLit -> [Lit] -> [Lit]
forall a. a -> [a] -> [a]
: String -> [String] -> [Lit]
allProg "code" [String]
xs
classify (x :: String
x:xs :: [String]
xs) | "\\begin{spec}"String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`String
x
= String -> Lit
Lit String
xLit -> [Lit] -> [Lit]
forall a. a -> [a] -> [a]
: String -> [String] -> [Lit]
allProg "spec" [String]
xs
classify (('>':x :: String
x):xs :: [String]
xs) = String -> Lit
Code ('>'Char -> String -> String
forall a. a -> [a] -> [a]
:String
x) Lit -> [Lit] -> [Lit]
forall a. a -> [a] -> [a]
: [String] -> [Lit]
classify [String]
xs
classify (x :: String
x:xs :: [String]
xs) = String -> Lit
Lit String
xLit -> [Lit] -> [Lit]
forall a. a -> [a] -> [a]
: [String] -> [Lit]
classify [String]
xs
allProg :: String -> [String] -> [Lit]
allProg name :: String
name = [String] -> [Lit]
go
where
end :: String
end = "\\end{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ "}"
go :: [String] -> [Lit]
go [] = []
go (x :: String
x:xs :: [String]
xs) | String
end `isPrefixOf `String
x
= String -> Lit
Lit String
xLit -> [Lit] -> [Lit]
forall a. a -> [a] -> [a]
: [String] -> [Lit]
classify [String]
xs
go (x :: String
x:xs :: [String]
xs) = String -> Lit
Code String
xLit -> [Lit] -> [Lit]
forall a. a -> [a] -> [a]
: [String] -> [Lit]
go [String]
xs
joinL :: [Lit] -> [Lit]
joinL :: [Lit] -> [Lit]
joinL [] = []
joinL (Code c :: String
c:Code c2 :: String
c2:xs :: [Lit]
xs) = [Lit] -> [Lit]
joinL (String -> Lit
Code (String
cString -> String -> String
forall a. [a] -> [a] -> [a]
++String
c2)Lit -> [Lit] -> [Lit]
forall a. a -> [a] -> [a]
:[Lit]
xs)
joinL (Lit c :: String
c :Lit c2 :: String
c2 :xs :: [Lit]
xs) = [Lit] -> [Lit]
joinL (String -> Lit
Lit (String
cString -> String -> String
forall a. [a] -> [a] -> [a]
++String
c2)Lit -> [Lit] -> [Lit]
forall a. a -> [a] -> [a]
:[Lit]
xs)
joinL (any :: Lit
any:xs :: [Lit]
xs) = Lit
anyLit -> [Lit] -> [Lit]
forall a. a -> [a] -> [a]
: [Lit] -> [Lit]
joinL [Lit]
xs