Trouble with the haskell ReadP (<++) function - parsing

At the moment I'm trying to learn Haskell by writing a parser for a certain type of log file.
if I execetue the following singleBlock parser:
singleBlock :: ReadP (String, String)
singleBlock = do
st <- look
if "LOAD INCREMENT" `isInfixOf` st then do
fmap (head . splitOn "LOAD INCREMENT") look >>= string
increment <- (munch PP.nonDigit >> munch PP.floatDot)
fmap (head. splitOn "STEP") look >>= string
munch PP.nonDigit
step <- munch PP.digit
return (increment, step)
else pfail
It produces the following output:
[("3.000E-01","1"),("3.000E-01","2"),("3.000E-01","3"),("1.000E-01","4"),("1","5")]
The problem is that the upon step 5 the file changes and thus the Float isn't parsed anymore.
If I change the increment line to:
increment <- (munch PP.nonDigitOnLine >> munch PP.floatDot >> munch PP.nonDigitOnLine >> munch PP.floatDot)
[("","1"),("","2"),("","3"),("","4"),("2.500E-01","5")]
The fift step gets parsed correctly. The first 4 steps produce an empty string, thus I thought I could change the increment line to this:
increment <- (munch PP.nonDigitOnLine >> munch PP.floatDot >> munch PP.nonDigitOnLine >> munch PP.floatDot) <++ (munch PP.nonDigit >> munch PP.floatDot)
Using the <++ left biased choice. It however doesn't change my output:
[("","1"),("","2"),("","3"),("","4"),("2.500E-01","5")]
Edit:
The log file is something like this (Focusing on the LOAD INCREMENT line):
STEP 4 INITIATED:
LOAD INCREMENT: START STEPS * 1.000E-01
SPARSE: DIM=272114 NNZ(MAT)=19119044
SOLVE: REDUCTION RES= 0.14E-12 (INIT. RES= 0.96E+06) NI= 1
ETA-ENERGY DIAGRAM 0 0.000E+00 3.182E+02
ETA-ENERGY DIAGRAM 1 1.000E+00 2.344E+00
STEP 4 : DISPLACEMENT NORM = 3.851E-03 TOLERANCE = 1.000E-02
STEP 4 : FORCE NORM = 6.558E+05 TOLERANCE = 1.000E-02
RELATIVE OUT OF BALANCE FORCE = 2.708E-01 CHECK = FALSE
SPARSE: DIM=272114 NNZ(MAT)=19119044
SOLVE: REDUCTION RES= 0.44E-14 (INIT. RES= 0.18E+06) NI= 1
ETA-ENERGY DIAGRAM 0 0.000E+00 2.239E+00
ETA-ENERGY DIAGRAM 1 1.000E+00 1.464E+00
...
...
RELATIVE DISPLACEMENT VARIATION = 6.156E-03 CHECK = TRUE
RELATIVE OUT OF BALANCE FORCE = 1.722E-01 CHECK = FALSE
STEP 4 TERMINATED, CONVERGENCE AFTER 2 ITERATIONS
EXECUTION STOPPED ON TOTAL LOAD CRITERION
CONTINUED ANALYSIS POSSIBLE.
TOTAL LOAD FACTOR: LOADING(12) * 1.000E+00
PLASTICITY LOGGING SUMMARY
GROUP NAME PLAST, PRV. PL, CRITIC, PLAST NEW, PRV.PL NEW, CRITIC NEW
TOTAL MODEL 0 0 0 0 0 0
CRACKING LOGGING SUMMARY
GROUP NAME CRACK, OPEN, CLOSED, ACTIVE, INACTI, ARISES, RE-OPENS, CLOSES
TOTAL MODEL 698 698 0 694 4 209 0 0
CUMULATIVE REACTION: FORCE X FORCE Y FORCE Z
0.89594D-09 0.11246D+02 -0.67820D-08
STEP 5 INITIATED:
LOAD INCREMENT: LOADING( 1) * 2.500E-01
SPARSE: DIM=272114 NNZ(MAT)=19119044
SOLVE: REDUCTION RES= 0.53E-10 (INIT. RES= 0.11E+06) NI= 1
STEP 5 : ENERGY NORM = 7.379E+02 TOLERANCE = 1.000E-04
SPARSE: DIM=272114 NNZ(MAT)=19119044
SOLVE: REDUCTION RES= 0.56E-14 (INIT. RES= 0.11E+06) NI= 1
...
...
STEP 5 TERMINATED, CONVERGENCE AFTER 13 ITERATIONS
TOTAL LOAD FACTOR: LOADING( 1) * 2.500E-01

Just 20 minutes later, it turns out I was to snappy with asking questions.
The problem is that the munch function always succeeds, thus I needed to provide an helper function that fails when the parsed string is null.
isFloatDot = do
s <- munch floatDot
if null s then pfail
else return s
The following snippet produces the correct output:
singleBlock :: ReadP (String, String)
singleBlock = do
st <- look
if "LOAD INCREMENT" `isInfixOf` st then do
fmap (head . splitOn "LOAD INCREMENT") look >>= string
increment <- (munch PP.nonDigitOnLine >> munch PP.floatDot >> munch PP.nonDigitOnLine >> PP.isFloatDot) <++ (munch PP.nonDigit >> munch PP.floatDot)
fmap (head. splitOn "STEP") look >>= string
munch PP.nonDigit
step <- munch PP.digit
return (increment, step)
else pfail

Related

Parsing large matrices in Haskell

I have recently started learning Haskell, I'm testing what I've learnt using the Google KickStart code challanges.
The problem I am looking at essentially asks to read square matrices from standard input and sum the elements on the diagonals parallel to the main diagonal.
I have written a simple program to solve the problem, this passes the first test but not the second.
The problem seems to be that the input in the second test is much larger than the first and the parsers I have written are either too slow or use too much memory.
The input is formatted as a sequence of matrices
n
a11 ... a1n
...
an1 ... ann
My first attempt using builtin function
type Matrix = [[Int]]
parseInput:: String -> [Matrix]
parseInput = parseInput' . lines
where
parseInput':: [String] -> [Matrix]
parseInput' [] = []
parseInput' (i:is) = let (m,rest) = splitAt (read i) is in
(map ((map read).words) m) : (parseInput' rest)
main = do
input <- getContents
let result = show $ parseInput input
putStr result
The second attempt using the parsec library
import Text.Parsec
import Text.Parsec.String (Parser)
type Row = [Int]
type Matrix = [[Int]]
matrixSize::(Integral a, Read a) => Parser a
matrixSize = do
n <- ( many1 digit ) <* newline
return $ read n
matrixRow:: Parser Row
matrixRow = do
row <- (sepBy1 (many1 digit) (char ' ')) <* (newline <|> (eof >> return ' '))
return $ map read row
parseMatrix:: Parser Matrix
parseMatrix = do
n <- matrixSize
mat <- count n matrixRow
return mat
parseInput:: Parser [Matrix]
parseInput = (many1 parseMatrix)
prepareInput:: String -> [Matrix]
prepareInput input = case parse parseInput "" input of
Right l -> l
Left _ -> []
main = do
input <- getContents
let result = show $ prepareInput input
putStr result
According to Google website the second test instance contains at most 100 matrices of which 10 are of size at most 1000 with elements of size at most 10^7, the remaining matrices are smaller of size at most 100.
I have generated a random test file with 10 large matrices of size at most 1000 and it turns out to be roughly 30MB in size.
Running either parser on the test file takes roughly 13s on my machine and the second uses more than 1GB of memory.
Both fail the requirements for running on the server: the first exceeds 20s execution time and the second fails the memory constraint of 1GB.
Is there a better way for parsing large files?
Is there any inefficiency that can be solved in my code?
Any advice will be greatly appreciated!

Parsing PPM images in Haskell

I'm starting to learn Haskell and wish to parse a PPM image for execrsice. The structure of the PPM format is rather simple, but it is tricky. It's described here. First of all, I defined a type for a PPM Image:
data Pixel = Pixel { red :: Int, green :: Int, blue :: Int} deriving(Show)
data BitmapFormat = TextualBitmap | BinaryBitmap deriving(Show)
data Header = Header { format :: BitmapFormat
, width :: Int
, height :: Int
, colorDepth :: Int} deriving(Show)
data PPM = PPM { header :: Header
, bitmap :: [Pixel]
}
bitmap should contain the entire image. This is where the first challange comes - the part that contains the actual image data in PPM can be either textual or binary (described in the header).
For textual bitmaps I wrote the following function:
parseTextualBitmap :: String -> [Pixel]
parseTextualBitmap = map textualPixel . chunksOf 3 . wordsBy isSpace
where textualPixel (r:g:b:[]) = Pixel (read r) (read g) (read b)
I'm not sure what to do with binary bitmaps, though. Using read converts a string representation of numbers to numbers. I want to convert "\x01" to 1 of type Int.
The second challange is parsing the header. I wrote the following function:
parseHeader :: String -> Header
parseHeader = constructHeader . wordsBy isSpace . filterComments
where
filterComments = unlines . map (takeWhile (/= '#')) . lines
formatFromText s
| s == "P6" = BinaryBitmap
| s == "P3" = TextualBitmap
constructHeader (format:width:height:colorDepth:_) =
Header (formatFromText format) (read width) (read height) (read colorDepth)
Which works pretty well. Now I should write the module exported function (let's call it parsePPM) which gets the entire file content (String) and then return PPM. The function should call parseHeader, deterime the bitmap format, call the apropriate parse(Textual|Binary)Bitmap and then construct a PPM with the result. Once parseHeader returns I should start decoding the bitmap from the point that parseHeader stopped in. However, I cannot know in which point of the string parseHeader stopped. The only solution I could think of is that instead of Header, parseHeader will return (Header,String), when the second element of the tuple is the remainder retrieved by constructHeader (which currently named as _). But I'm not really sure it's the "Haskell Way" of doing things.
To sum up my questions:
1. How do I decode the binary format into a list of Pixel
2. How can I know in which point the header ends
Since I'm learning Haskell by myself I have no one to actually review my code, so in addition to answering my questions I will appriciate any comment about the way I code (coding style, bugs, alternative way to do things, etc...).
Lets start with question 2 because it is easier to answer. Your approach is correct: as you parse things, you remove those characters from the input string, and return a tuple containing the result of the parse, and the remaining string. However, thereis no reason to write all this from scratch (except perhaps as an academic exercise) - there are plenty of parsers which will take care of this issue for you. The one I will use is Parsec. If you are new to monadic parsing you should first read the section on Parsec in RWH.
As for question 1, if you use ByteString instead of String, then parsing single bytes is easy since single bytes are the atomic elements of ByteStrings!
There is also the issue of the Char/ByteString interface. With Parsec, this is a non-issue since you can treat a ByteString as a sequence of Byte or Char - we will see this later.
I decided to just write the full parser - this is a very simple language so with all the primitives defined for you in the Parsec library, it is very easy and very concise.
The file header:
import Text.Parsec.Combinator
import Text.Parsec.Char
import Text.Parsec.ByteString
import Text.Parsec
import Text.Parsec.Pos
import Data.ByteString (ByteString, pack)
import qualified Data.ByteString.Char8 as C8
import Control.Monad (replicateM)
import Data.Monoid
First, we write the 'primitive' parsers - that is, parsing bytes, parsing textual numbers, and parsing whitespace (which the PPM format uses as a seperator):
parseIntegral :: (Read a, Integral a) => Parser a
parseIntegral = fmap read (many1 digit)
digit parses a single digit - you'll notice that many function names explain what the parser does - and many1 will apply the given parser 1 or more times. Then we read the resulting string to return an actual number (as opposed to a string). In this case, the input ByteString is being treated as text.
parseByte :: Integral a => Parser a
parseByte = fmap (fromIntegral . fromEnum) $ tokenPrim show (\pos tok _ -> updatePosChar pos tok) Just
For this parser, we parse a single Char - which is really just a byte. It is just returned as a Char. We could safely make the return type Parser Word8 because the universe of values that can be returned is [0..255]
whitespace1 :: Parser ()
whitespace1 = many1 (oneOf "\n ") >> return ()
oneOf takes a list of Char and parses any one of the characters in the order given - again, the ByteString is being treated as Text.
Now we can write the parser for the header.
parseHeader :: Parser Header
parseHeader = do
f <- choice $ map try $
[string "P3" >> return TextualBitmap
,string "P6" >> return BinaryBitmap]
w <- whitespace1 >> parseIntegral
h <- whitespace1 >> parseIntegral
d <- whitespace1 >> parseIntegral
return $ Header f w h d
A few notes. choice takes a list of parsers and tries them in order. try p takes the parser p, and 'remembers' the state before p starts parsing. If p succeeds, then try p == p. If p fails, then the state before p started is restored and you pretend you never tried p. This is necessary due to how choice behaves.
For the pixels, we have two choices as of now:
parseTextual :: Header -> Parser [Pixel]
parseTextual h = do
xs <- replicateM (3 * width h * height h) (whitespace1 >> parseIntegral)
return $ map (\[a,b,c] -> Pixel a b c) $ chunksOf 3 xs
We could use many1 (whitespace 1 >> parseIntegral) - but this wouldn't enforce the fact that we know what the length should be. Then, converting the list of numbers to a list of pixels is trivial.
For binary data:
parseBinary :: Header -> Parser [Pixel]
parseBinary h = do
whitespace1
xs <- replicateM (3 * width h * height h) parseByte
return $ map (\[a,b,c] -> Pixel a b c) $ chunksOf 3 xs
Note how the two are almost identical. You could probably generalize this function (it would be especially useful if you decided to parse the other types of pixel data - monochrome and greyscale).
Now to bring it all together:
parsePPM :: Parser PPM
parsePPM = do
h <- parseHeader
fmap (PPM h) $
case format h of
TextualBitmap -> parseTextual h
BinaryBitmap -> parseBinary h
This should be self-explanatory. Parse the header, then parse the body based on the format. Here are some examples to try it on. They are the ones from the specification page.
example0 :: ByteString
example0 = C8.pack $ unlines
["P3"
, "4 4"
, "15"
, " 0 0 0 0 0 0 0 0 0 15 0 15"
, " 0 0 0 0 15 7 0 0 0 0 0 0"
, " 0 0 0 0 0 0 0 15 7 0 0 0"
, "15 0 15 0 0 0 0 0 0 0 0 0" ]
example1 :: ByteString
example1 = C8.pack ("P6 4 4 15 ") <>
pack [0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 0, 15, 0, 0, 0, 0, 15, 7,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 7, 0, 0, 0, 15,
0, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0 ]
Several notes: this doesn't handle comments, which are part of the spec. The error messages are not very useful; you can use the <?> function to create your own error messages. The spec also indicates 'The lines should not be longer than 70 characters.' - this is also not enforced.
edit:
Just because you see do-notation, doesn't necessarily mean that you are working with impure code. Some monads (like this parser) are still pure - they are just used for convenience. For example, you can write your parser with the type parser :: String -> (a, String), or, what we have done here, is we use a new type: data Parser a = Parser (String -> (a, String)) and have parser :: Parser a; we then write a monad instance for Parser to get the useful do-notation. To be clear, Parsec supports monadic parsing, but our parser is not monadic - or rather, uses the Identity monad, which is just newtype Identity a = Identity { runIdentity :: a }, and is only necessary because if we used type Identity a = a we would have 'overlapping instances' errors everywhere, which is not good.
>:i Parser
type Parser = Parsec ByteString ()
-- Defined in `Text.Parsec.ByteString'
>:i Parsec
type Parsec s u = ParsecT s u Data.Functor.Identity.Identity
-- Defined in `Text.Parsec.Prim'
So then, the type of Parser is really ParsecT ByteString () Identity. That is, the parser input is ByteString, the user state is () - which just means we aren't using the user state, and the monad in which we are parsing is Identity. ParsecT is itself just a newtype of:
forall b.
State s u
-> (a -> State s u -> ParseError -> m b)
-> (ParseError -> m b)
-> (a -> State s u -> ParseError -> m b)
-> (ParseError -> m b)
-> m b
All those functions in the middle are just used to pretty-print errors. If you are parsing 10's of thousands of characters and an error occurs, you won't be able to just look at it and see where that happened - but Parsec will tell you the line and column. If we specialize all the types to our Parser, and pretend that Identity is just type Identity a = a, then all the monads disappear and you can see that the parser is not impure. As you can see, Parsec is a lot more powerful than is required for this problem - I just used it due to familiarity, but if you were willing to write your own primitive functions like many and digit, then you could get away with using newtype Parser a = Parser (ByteString -> (a, ByteString)).

Making a Read instance in Haskell

I have a data type
data Time = Time {hour :: Int,
minute :: Int
}
for which i have defined the instance of Show as being
instance Show Time where
show (Time hour minute) = (if hour > 10
then (show hour)
else ("0" ++ show hour))
++ ":" ++
(if minute > 10
then (show minute)
else ("0" ++ show minute))
which prints out times in a format of 07:09.
Now, there should be symmetry between Show and Read, so after reading (but not truly (i think) understanding) this and this, and reading the documentation, i have come up with the following code:
instance Read Time where
readsPrec _ input =
let hourPart = takeWhile (/= ':')
minutePart = tail . dropWhile (/= ':')
in (\str -> [(newTime
(read (hourPart str) :: Int)
(read (minutePart str) :: Int), "")]) input
This works, but the "" part makes it seem wrong. So my question ends up being:
Can anyone explain to me the correct way to implement Read to parse "07:09" into newTime 7 9 and/or show me?
I'll use isDigit and keep your definition of Time.
import Data.Char (isDigit)
data Time = Time {hour :: Int,
minute :: Int
}
You used but didn't define newTime, so I wrote one myself so my code compiles!
newTime :: Int -> Int -> Time
newTime h m | between 0 23 h && between 0 59 m = Time h m
| otherwise = error "newTime: hours must be in range 0-23 and minutes 0-59"
where between low high val = low <= val && val <= high
Firstly, your show instance is a little wrong because show $ Time 10 10 gives "010:010"
instance Show Time where
show (Time hour minute) = (if hour > 9 -- oops
then (show hour)
else ("0" ++ show hour))
++ ":" ++
(if minute > 9 -- oops
then (show minute)
else ("0" ++ show minute))
Let's have a look at readsPrec:
*Main> :i readsPrec
class Read a where
readsPrec :: Int -> ReadS a
...
-- Defined in GHC.Read
*Main> :i ReadS
type ReadS a = String -> [(a, String)]
-- Defined in Text.ParserCombinators.ReadP
That's a parser - it should return the unmatched remaining string instead of just "", so you're right that the "" is wrong:
*Main> read "03:22" :: Time
03:22
*Main> read "[23:34,23:12,03:22]" :: [Time]
*** Exception: Prelude.read: no parse
It can't parse it because you threw away the ,23:12,03:22] in the first read.
Let's refactor that a bit to eat the input as we go along:
instance Read Time where
readsPrec _ input =
let (hours,rest1) = span isDigit input
hour = read hours :: Int
(c:rest2) = rest1
(mins,rest3) = splitAt 2 rest2
minute = read mins :: Int
in
if c==':' && all isDigit mins && length mins == 2 then -- it looks valid
[(newTime hour minute,rest3)]
else [] -- don't give any parse if it was invalid
Gives for example
Main> read "[23:34,23:12,03:22]" :: [Time]
[23:34,23:12,03:22]
*Main> read "34:76" :: Time
*** Exception: Prelude.read: no parse
It does, however, allow "3:45" and interprets it as "03:45". I'm not sure that's a good idea, so perhaps we could add another test length hours == 2.
I'm going off all this split and span stuff if we're doing it this way, so maybe I'd prefer:
instance Read Time where
readsPrec _ (h1:h2:':':m1:m2:therest) =
let hour = read [h1,h2] :: Int -- lazily doesn't get evaluated unless valid
minute = read [m1,m2] :: Int
in
if all isDigit [h1,h2,m1,m2] then -- it looks valid
[(newTime hour minute,therest)]
else [] -- don't give any parse if it was invalid
readsPrec _ _ = [] -- don't give any parse if it was invalid
Which actually seems cleaner and simpler to me.
This time it doesn't allow "3:45":
*Main> read "3:40" :: Time
*** Exception: Prelude.read: no parse
*Main> read "03:40" :: Time
03:40
*Main> read "[03:40,02:10]" :: [Time]
[03:40,02:10]
If the input to readsPrec is a string that contains some other characters after a valid representation of a Time, those other characters should be returned as the second element of the tuple.
So for the string 12:34 bla, the result should be [(newTime 12 34, " bla")]. Your implementation would cause an error for that input. This means that something like read "[12:34]" :: [Time] would fail because it would call Time's readsPrec with "12:34]" as the argument (because readList would consume the [, then call readsPrec with the remaining string, and then check that the remaining string returned by readsPrec is either ] or a comma followed by more elements).
To fix your readsPrec you should rename minutePart to something like afterColon and then split that into the actual minute part (with takeWhile isDigit for example) and whatever comes after the minute part. Then the stuff that came after the minute part should be returned as the second element of the tuple.

Checking that a price value in a string is in the correct format

I use n <- getLine to get from user price. How can I check is value correct ? (Price can have '.' and digits and must be greater than 0) ?
It doesn't work:
isFloat = do
n <- getLine
let val = case reads n of
((v,_):_) -> True
_ -> False
If The Input Is Always Valid Or Exceptions Are OK
If you have users entering decimal numbers in the form of "123.456" then this can simply be converted to a Float or Double using read:
n <- getLine
let val = read n
Or in one line (having imported Control.Monad):
n <- liftM read getLine
To Catch Erroneous Input
The above code fails with an exception if the users enter invalid entries. If that's a problem then use reads and listToMaybe (from Data.Maybe):
n <- liftM (fmap fst . listToMaybe . reads) getLine
If that code looks complex then don't sweat it - the below is the same operation but doing all the work with explicit case statements:
n <- getLine
let val = case reads n of
((v,_):_) -> Just v
_ -> Nothing
Notice we pattern match to get the first element of the tuple in the head of the list, The head of the list being (v,_) and the first element is v. The underscore (_) just means "ignore the value in this spot".
If Floating Point Isn't Acceptable
Floating values are well known to be approximate, and not suitable for real world financial computations (but perhaps homework, depending on your professor). In this case you'd want to read the values into a Rational (from Data.Ratio).
n <- liftM maybeRational getLine
...
where
maybeRational :: String -> Maybe Rational
maybeRational str =
let (a,b) = break (=='.') str
in liftM2 (%) (readMaybe a) (readMaybe $ drop 1 b)
readMaybe = fmap fst . listToMaybe . reads
In addition to the parsing advice provided by TomMD, consider using the appropriate monad for error reporting. It allows you to conveniently chain computations which can fail, avoiding explicit error checking on every step.
{-# LANGUAGE FlexibleContexts #-}
import Control.Monad.Error
parsePrice :: MonadError String m => String -> m Double
parsePrice s = do
x <- case reads s of
[(x, "")] -> return x
_ -> throwError "Not a valid real number."
when (x <= 0) $ throwError "Price must be positive."
return x
main = do
n <- getLine
case parsePrice n of
Left err -> putStrLn err
Right x -> putStrLn $ "Price is " ++ show x

megaparsec reports incorrect location on parse error

For this project I'm parsing in two stages. The first stage handles include/ifdef/define directives and chunks the input up into [Span] items which define their start/end points in the original inputs along with the body text. This stream is then parsed by the second stage into my AST for subsequent processing.
Each element of the AST carries it's source position and any semantic error caught after parsing prints the correct error position regardless of include depth. This part is crucial since it comes after the stage that has the problem.
The problem is given a parse error in the second stage from an included file it reports a bogus error with a location at the top level rule in the input. A parse error in the initial file works fine. The presence of any directives will divide even the initial file into multiple chunks so it's not a 'single chunk' vs. 'multiple chunks' issue.
Given the fact that the AST is getting the locations correct I'm stumped as to how Megaparsec is reporting bad info when parse errors are encountered.
I'm included my stream instance and (set|get)(Position|Input) code since these seem like the relevant bits. i feel like there must be some bit of megaparsec housekeeping that I'm not doing or that my Stream instance is invalid for some reason.
data Span = Span
{ spanStart :: SourcePos
, spanEnd :: SourcePos
, spanBody :: T.Text
} deriving (Eq, Ord, Show)
instance Stream [Span] where
type Token [Span] = Span
type Tokens [Span] = [Span]
tokenToChunk Proxy = pure
tokensToChunk Proxy = id
chunkToTokens Proxy = id
chunkLength Proxy = foldl1 (+) . map (T.length . spanBody)
chunkEmpty Proxy = all ((== 0) . T.length . spanBody)
positionAt1 Proxy pos (Span start _ _) = trace ("pos1" ++ show start) start
positionAtN Proxy pos [] = pos
positionAtN Proxy _ (Span start _ _:_) = trace ("posN" ++ show start) start
advance1 Proxy _ _ (Span _ end _) = end
advanceN Proxy _ pos [] = pos
advanceN Proxy _ _ ts = let Span _ end _ = last ts in end
take1_ [] = Nothing
take1_ s = case takeN_ 1 s of
Nothing -> Nothing
Just (sp, s') -> Just (head sp, s')
takeN_ _ [] = Nothing
takeN_ n s#(t:ts)
| s == [] = Nothing
| n <= 0 = Just ([t {spanEnd = spanStart t, spanBody = ""}], s)
| n < (T.length . spanBody) t = let (l, r) = T.splitAt n (spanBody t)
sL = spanStart t
eL = foldl (defaultAdvance1 (mkPos 3)) sL (T.unpack (T.tail l))
sR = defaultAdvance1 (mkPos 3) eL (T.last l)
eR = spanEnd t
l' = [Span sL eL l]
r' = (Span sR eR r):ts
in Just (trace (show n) l', r')
| n == (T.length . spanBody) t = Just ([t], ts)
| otherwise = case takeN_ (n - T.length (spanBody t)) ts of
Nothing -> Just ([t], [])
Just (t', ts') -> Just (t:t', ts')
takeWhile_ p s = fromJust $ takeN_ (go 0 s) s
where go n s = case take1_ s of
Nothing -> n
Just (c, s') -> if p c
then go (n + 1) s'
else n
Find include and swap to it:
"include" -> do
file <- between dquote dquote (many (alphaNumChar <|> char '.' <|> char '/' <|> char '_'))
s <- liftIO (Data.Text.IO.readFile file)
p <- getPosition
i <- getInput
pushPosition p
stack %= (:) (p, i)
setPosition (initialPos file)
setInput s
And if we reach the end of input pop stack and continue:
parseStream' :: StreamParser [Span]
parseStream' = concat <$> many p
where p = do
b <- tick <|> block
end <- option False (True <$ hidden eof)
h <- use stack
when (end && (h /= [])) $ do
popPosition
setInput (h ^?! ix 0 . _2)
stack %= tail
return b

Resources