module Data.OrgMode.Text (
LineNumber(..), toNumber, TextLine(..), isNumber, TextLineSource(..),
normalizeInputText, lineAdd, linesStartingFrom, hasNumber, makeDrawerLines,
wrapLine, prefixLine, tlPrint, tlFormat, wrapStringVarLines
) where
import Data.List (intercalate)
import Data.Monoid
import Data.Typeable
import Data.Generics (Generic(..))
import Data.Char (isSpace, toUpper, isPrint)
import Text.Printf
import System.IO
type LineNumber = Maybe Int
lineAdd Nothing _ = Nothing
lineAdd _ Nothing = Nothing
lineAdd (Just a) (Just b) = Just (a+b)
toNumber :: Int -> LineNumber -> Int
toNumber n Nothing = n
toNumber _ (Just a) = a
isNumber :: LineNumber -> Bool
isNumber Nothing = False
isNumber (Just _) = True
linesStartingFrom :: LineNumber -> [LineNumber]
linesStartingFrom Nothing = repeat Nothing
linesStartingFrom (Just l) = map Just [l..]
data TextLine = TextLine
{ tlIndent :: Int
, tlText :: String
, tlLineNum :: LineNumber
} deriving (Eq, Typeable)
hasNumber :: TextLine -> Bool
hasNumber (TextLine _ _ (Just _)) = True
hasNumber _ = False
formatLine tl =
(printf "[%3d] " (tlIndent tl)) ++
(printf "%-8s" $ (show $ tlLineNum tl)) ++ "|" ++ (tlText tl)
instance Show TextLine where
show tl = "<" ++ (formatLine tl) ++ ">"
instance Ord TextLine where
compare a b = compare (tlLineNum a) (tlLineNum b)
class TextLineSource s where
getTextLines :: s -> [TextLine]
normalizeInputText :: String -> String
normalizeInputText text =
let swapCrLf :: String -> Char -> String
swapCrLf ('\r':cs) '\n' = '\n':cs
swapCrLf ('\n':cs) '\r' = '\n':cs
swapCrLf cs c = c:cs
swapCr :: String -> Char -> String
swapCr cs '\r' = '\n':cs
swapCr cs c = c:cs
revStr = reverse text
swappedCrLf = foldl swapCrLf "" revStr
swappedCr = foldl swapCr "" swappedCrLf
in reverse swappedCr
trimEndOfLine :: String -> String
trimEndOfLine f = reverse $ dropWhile isSpace $ reverse f
wrapStringVarLines :: [Int] -> String -> String
wrapStringVarLines _ [] = []
wrapStringVarLines lens str
| length str < (head lens) = str
| otherwise =
let first_word = takeWhile (not . isSpace) str
len = head lens
is_first_too_long = length first_word >= len
wrapped_back =
if is_first_too_long
then first_word
else reverse $ dropWhile (not . isSpace) $ reverse $ take len str
remain = drop (length wrapped_back) str
in if length wrapped_back > 0 || length remain > 0
then wrapped_back ++ "\n" ++ wrapStringVarLines (drop 1 lens) remain
else ""
wrapString :: Int -> String -> String
wrapString len str = wrapStringVarLines (repeat len) str
wrapLine :: Int -> TextLine -> [TextLine]
wrapLine width (TextLine indent string linenum) =
let desired_len = width indent
strings = concatMap lines $ map (wrapString desired_len) $ lines string
line_nrs = linesStartingFrom linenum
makeTextLine (str, nr) = TextLine indent (trimEndOfLine str) nr
in map makeTextLine $ zip strings line_nrs
prefixLine :: String -> TextLine -> TextLine
prefixLine pfx (TextLine indent string linenum) =
let new_str = pfx ++ string
new_indent = length $ takeWhile isSpace new_str
in TextLine new_indent new_str linenum
makeDrawerLines :: LineNumber -> Int -> String -> [(String, String)] -> [TextLine]
makeDrawerLines fstLine depth name props =
let !indent = take depth $ repeat ' '
headline =
TextLine depth (indent ++ ":" ++ (map toUpper name) ++ ":") fstLine
mAdd (Just x) y = Just (x + y)
mAdd Nothing y = Nothing
lastline =
TextLine depth (indent ++ ":END:") (lineAdd fstLine $ Just (length props + 1))
makePropLine ((prop, value), nr) =
TextLine depth (indent ++ ":" ++ prop ++ ": " ++ value) (lineAdd fstLine $ Just nr)
proplines = map makePropLine $ zip props [1..]
in (headline:(proplines)) ++ [lastline]
tlFormat :: (TextLineSource s) => s -> String
tlFormat s =
let lines = getTextLines s
in intercalate "\n" $ map formatLine lines
tlPrint :: (TextLineSource s) => s -> IO ()
tlPrint s = putStrLn $ tlFormat s