module Text.LDIF.Preproc ( preproc
, transposePos
, PosTable )
where
import Text.Parsec
import Text.Parsec.Error (setErrorPos)
import qualified Data.ByteString.Char8 as BC
import Data.List (foldl', sortBy)
type PosTable = [ PosOp ]
data PosOp = PosOpAddLine { psLine :: Int }
| PosOpWrap { psLine :: Int, psW :: Int, psWP :: Int } deriving Show
data LdifLine = LdifLine { llNum :: Int, llStr :: BC.ByteString }
| LdifLineCont { llNum :: Int, llStr :: BC.ByteString }
| LdifComment { llNum :: Int, llStr :: BC.ByteString }
transposePos :: PosTable -> ParseError -> ParseError
transposePos ptab oe = setErrorPos npos oe
where
opos = errorPos oe
npos = setSourceColumn (setSourceLine opos nlin) ncol
where
opIdx a b = (psLine a) `compare` (psLine b)
ocord = (sourceLine opos,sourceColumn opos)
(nlin,ncol) = calcPos (sortBy opIdx ptab) ocord
calcPos :: PosTable -> (Int, Int) -> (Int, Int)
calcPos xs cord = foldl' updatePos cord xs
where
updatePos (l0,c0) (PosOpAddLine l) | l0 >= l = (l0+1,c0)
updatePos (l0,c0) (PosOpWrap l _ _) | l0 >= l = (l0+1,c0)
updatePos (l0,c0) (PosOpWrap l w wp) | (l0+1) == l && c0 > w && (c01w) > wp = (l0+1,c0)
updatePos (l0,c0) (PosOpWrap l w wp) | (l0+1) == l && c0 > w && (c01w) <= wp = (l0+1,c0w)
updatePos x _ = x
preproc :: BC.ByteString -> (BC.ByteString, PosTable)
preproc xs = (str, ptab)
where
str = BC.unlines $ map llStr ys
(ys, ptab) = lns xs
where
lns zs = stripComments $ unwrap $ (tokenizeLines $ specLines zs, [])
specLines :: BC.ByteString -> [BC.ByteString]
specLines xs = map cleanLine $ BC.lines xs
where
isCR c = c == '\r'
cleanLine l | BC.null l = l
| isCR (BC.last l) = cleanLine $ BC.init l
| otherwise = l
tokenizeLines :: [BC.ByteString] -> [LdifLine]
tokenizeLines xs = map tokenizeLine $ zip xs [1..]
where
tokenizeLine (x,i) | BC.null x = LdifLine i BC.empty
| BC.head x == '#' = LdifComment i x
| BC.head x == ' ' = LdifLineCont i $ BC.tail x
| otherwise = LdifLine i x
stripComments :: ([LdifLine],PosTable) -> ([LdifLine],PosTable)
stripComments (xs,pt) = foldl' procLine ([],pt) xs
where
procLine (v,p) (LdifComment i _) = (v,(PosOpAddLine i):p)
procLine (v,p) o = (o:v,p)
unwrap :: ([LdifLine],PosTable) -> ([LdifLine],PosTable)
unwrap (xs,pt) = foldl' procLine ([],pt) xs
where
procLine ([],p) o = (o:[],p)
procLine (v,p) (LdifLineCont i s) = let (z,r) = splitAt 1 v
o = head z
o' = o { llStr = (llStr o) `BC.append` s }
p' = (PosOpWrap i (BC.length $ llStr o) (BC.length s)):p
in (o':r,p')
procLine (v,p) o = (o:v,p)