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 ColourPrefs
pref Bool
anchor Bool
partial String
title Bool
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 Int
1
hscolour Output
output ColourPrefs
pref Bool
anchor Bool
partial String
title Bool
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 Int
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 Int
_ [] = []
chunk Int
n (Code String
c: [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 a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> [String]
lines String
c)) [Lit]
cs
chunk Int
n (Lit String
c: [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' Output
TTY ColourPrefs
pref Bool
_ Int
_ = ColourPrefs -> String -> String
TTY.hscolour ColourPrefs
pref
hscolour' (TTYg TerminalType
tt) ColourPrefs
pref Bool
_ Int
_ = TerminalType -> ColourPrefs -> String -> String
TTY.hscolourG TerminalType
tt ColourPrefs
pref
hscolour' Output
MIRC ColourPrefs
pref Bool
_ Int
_ = ColourPrefs -> String -> String
MIRC.hscolour ColourPrefs
pref
hscolour' Output
LaTeX ColourPrefs
pref Bool
_ Int
_ = ColourPrefs -> String -> String
LaTeX.hscolour ColourPrefs
pref
hscolour' Output
HTML ColourPrefs
pref Bool
anchor Int
n = ColourPrefs -> Bool -> Int -> String -> String
HTML.hscolour ColourPrefs
pref Bool
anchor Int
n
hscolour' Output
CSS ColourPrefs
_ Bool
anchor Int
n = Bool -> Int -> String -> String
CSS.hscolour Bool
anchor Int
n
hscolour' Output
ICSS ColourPrefs
pref Bool
anchor Int
n = ColourPrefs -> Bool -> Int -> String -> String
ICSS.hscolour ColourPrefs
pref Bool
anchor Int
n
hscolour' Output
ACSS ColourPrefs
_ Bool
anchor 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 Output
TTY String
_ = String -> String
forall a. a -> a
id
top'n'tail (TTYg TerminalType
_) String
_ = String -> String
forall a. a -> a
id
top'n'tail Output
MIRC String
_ = String -> String
forall a. a -> a
id
top'n'tail Output
LaTeX String
title = String -> String -> String
LaTeX.top'n'tail String
title
top'n'tail Output
HTML String
title = String -> String -> String
HTML.top'n'tail String
title
top'n'tail Output
CSS String
title = String -> String -> String
CSS.top'n'tail String
title
top'n'tail Output
ICSS String
title = String -> String -> String
ICSS.top'n'tail String
title
top'n'tail Output
ACSS 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
$cshowsPrec :: Int -> Lit -> String -> String
showsPrec :: Int -> Lit -> String -> String
$cshow :: Lit -> String
show :: Lit -> String
$cshowList :: [Lit] -> String -> String
showList :: [Lit] -> String -> String
Show)
inlines :: String -> [String]
inlines :: String -> [String]
inlines String
s = String -> (String -> String) -> [String]
lines' String
s String -> String
forall a. a -> a
id
where
lines' :: String -> (String -> String) -> [String]
lines' [] String -> String
acc = [String -> String
acc []]
lines' (Char
'\^M':Char
'\n':String
s) String -> String
acc = String -> String
acc [Char
'\n'] String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> (String -> String) -> [String]
lines' String
s String -> String
forall a. a -> a
id
lines' (Char
'\n':String
s) String -> String
acc = String -> String
acc [Char
'\n'] String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> (String -> String) -> [String]
lines' String
s String -> String
forall a. a -> a
id
lines' (Char
c:String
s) 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 (String
x:[String]
xs) | String
"\\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 String
"code" [String]
xs
classify (String
x:[String]
xs) | String
"\\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 String
"spec" [String]
xs
classify ((Char
'>':String
x):[String]
xs) = String -> Lit
Code (Char
'>'Char -> String -> String
forall a. a -> [a] -> [a]
:String
x) Lit -> [Lit] -> [Lit]
forall a. a -> [a] -> [a]
: [String] -> [Lit]
classify [String]
xs
classify (String
x:[String]
xs) = String -> Lit
Lit String
xLit -> [Lit] -> [Lit]
forall a. a -> [a] -> [a]
: [String] -> [Lit]
classify [String]
xs
allProg :: String -> [String] -> [Lit]
allProg String
name = [String] -> [Lit]
go
where
end :: String
end = String
"\\end{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"
go :: [String] -> [Lit]
go [] = []
go (String
x:[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 (String
x:[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 String
c:Code String
c2:[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 String
c :Lit String
c2 :[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 (Lit
any:[Lit]
xs) = Lit
anyLit -> [Lit] -> [Lit]
forall a. a -> [a] -> [a]
: [Lit] -> [Lit]
joinL [Lit]
xs