diff --git a/app/Main.hs b/app/Main.hs index 6c8fa8a303544be7ec1ba4e108d09f1e70c8ae9f..464b017ad45b8ea41d7a73625af149c8d63e40da 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/lib/Text/InvisiXML.hs b/lib/Text/InvisiXML.hs index 4f6a418e112bb53e9b5483be412d8c0187c6e00e..8b09f8b79da28e259f2493d71d17e309e0f6484f 100644 --- a/lib/Text/InvisiXML.hs +++ b/lib/Text/InvisiXML.hs @@ -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 }