Commit af3d5724 authored by Alice Brenon's avatar Alice Brenon
Browse files

Wire the --pristine option downto the parser

parent 9f911158
......@@ -6,7 +6,7 @@ import Control.Monad.Except (runExceptT)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text.IO as Text (getContents, readFile, writeFile)
import Text.InvisiXML (InvisiXML(..), parse)
import Text.InvisiXML as Parser (InvisiXML(..), ParsingConfig(..), parse)
import Text.XML.Light.Serializer (encode)
import System.FilePath ((<.>), dropExtension)
import System.Exit (die)
......@@ -22,8 +22,10 @@ endPoints (Command {input = FileInput f, outputPrefix}) =
run :: Command -> IO ()
run command = do
(source, prefix) <- endPoints command
source >>= runExceptT . parse >>= either (fail . show) (create prefix)
source >>= runExceptT . parse parsingConfig
>>= either (fail . show) (create prefix)
where
parsingConfig = ParsingConfig {Parser.pristine = CLI.pristine command}
create prefix (InvisiXML {text, structure}) = do
Text.writeFile (prefix <.> "txt") text
writeFile (prefix <.> "ixml") $ encode structure
......
......@@ -2,13 +2,14 @@
{-# LANGUAGE FlexibleContexts #-}
module Text.InvisiXML (
InvisiXML(..)
, ParsingConfig(..)
, Structure(..)
, merge
, parse
) where
import Control.Monad.Except (MonadError(..))
import Control.Monad.State (StateT(..), execStateT, gets, modify, state)
import Control.Monad.RWS (RWST(..), execRWST, asks, gets, modify, state)
import Data.Char (isSpace)
import Data.List (uncons)
import Data.PositionTree as PositionTree (
......@@ -80,6 +81,10 @@ data ParsingState = ParsingState {
, subStructure :: Structure
}
data ParsingConfig = ParsingConfig {
pristine :: Bool
}
openStream :: [Token] -> ParsingState
openStream input = ParsingState {
input
......@@ -89,7 +94,7 @@ openStream input = ParsingState {
, subStructure = Structure empty
}
type Parser = StateT ParsingState
type Parser = RWST ParsingConfig () ParsingState
pop :: Monad m => Parser m (Maybe Token)
pop = gets (uncons . input) >>= updateState
......@@ -99,9 +104,9 @@ pop = gets (uncons . input) >>= updateState
state $ \parsingState -> (Just t, parsingState {input})
appendText :: Monad m => String -> Parser m ()
appendText s = modify append
appendText s = asks (toText . pristine) >>= modify . append
where
t = Text.pack $ unindent s
toText b = Text.pack $ (if b then id else unindent) s
unindent ('\n':s') = '\n':(unindent $ dropWhile isSpace s')
{-
case dropWhile isSpace s' of
......@@ -110,7 +115,7 @@ appendText s = modify append
-}
unindent (c:s') = c:(unindent s')
unindent [] = []
append parsingState
append t parsingState
| Text.null t = parsingState
| otherwise = parsingState {
at = offset t $ at parsingState
......@@ -143,10 +148,12 @@ checkout actual = gets context >>= compareWith actual
| tag tO0 /= tag tO1 = throwError $ Mismatch {open = tO0, close = tO1}
compareWith _ _ = return ()
parse :: (XmlSource s, MonadError XMLError m) => s -> m InvisiXML
parse = fmap collectState . execStateT fillStructure . openStream . tokens
parse :: (XmlSource s, MonadError XMLError m) =>
ParsingConfig -> s -> m InvisiXML
parse config =
fmap collectState . execRWST fillStructure config . openStream . tokens
where
collectState (ParsingState {stack, subStructure}) = InvisiXML {
collectState (ParsingState {stack, subStructure}, _) = InvisiXML {
structure = subStructure
, text = Text.concat $ reverse stack
}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment