From da0fb00dc7f57938ebc01d525a3c4ec4d00d96de Mon Sep 17 00:00:00 2001 From: Benjamin Barenblat Date: Wed, 11 Feb 2015 18:40:59 -0500 Subject: Parse fragments --- src/Fragment.hs | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++++ src/Main.hs | 16 +++++++++++++++- 2 files changed, 67 insertions(+), 1 deletion(-) create mode 100644 src/Fragment.hs (limited to 'src') diff --git a/src/Fragment.hs b/src/Fragment.hs new file mode 100644 index 0000000..2d45ff4 --- /dev/null +++ b/src/Fragment.hs @@ -0,0 +1,52 @@ +{- Copyright © 2015 Benjamin Barenblat + +This program is free software: you can redistribute it and/or modify it under +the terms of the GNU General Public License as published by the Free Software +Foundation, either version 3 of the License, or (at your option) any later +version. + +This program is distributed in the hope that it will be useful, but WITHOUT ANY +WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A +PARTICULAR PURPOSE. See the GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along with +this program. If not, see . -} + +module Fragment ( Fragment + , parseStdin + , parseFile + , ParseError) where + +import Data.Data (Data) +import Data.Typeable (Typeable) +import GHC.Generics (Generic) + +import Control.Applicative ((<$>), (<*>), pure) +import Control.Monad (void) +import System.IO (hGetContents, stdin) +import Text.Parsec +import Text.Parsec.String + +data Fragment = Documentation String + | BlockCode String String + deriving (Eq, Show, Data, Typeable, Generic) + +parseStdin :: IO (Either ParseError [Fragment]) +parseStdin = parse literateFile "" <$> hGetContents stdin + +parseFile :: FilePath -> IO (Either ParseError [Fragment]) +parseFile = parseFromFile literateFile + +literateFile :: Parser [Fragment] +literateFile = alternate documentation blockCode + +documentation :: Parser Fragment +documentation = Documentation <$> manyTill anyChar (void (string "<<") <|> eof) + +blockCode :: Parser Fragment +blockCode = + BlockCode <$> manyTill anyChar (void $ string ">>=") + <*> manyTill anyChar (void $ char '@') + +alternate :: Parser a -> Parser a -> Parser [a] +alternate x y = (:) <$> x <*> (alternate y x <|> pure []) diff --git a/src/Main.hs b/src/Main.hs index f569b1a..d69710c 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -14,5 +14,19 @@ this program. If not, see . -} module Main where +import System.Environment (getArgs) +import System.Exit (exitFailure) + +import Fragment (parseFile, parseStdin) + main :: IO () -main = putStrLn "Hello, world!" +main = do + args <- getArgs + parsed <- case args of + [] -> parseStdin + [f] -> parseFile f + _ -> usage >> exitFailure + print parsed + +usage :: IO () +usage = putStrLn "usage: lyt [file]" -- cgit v1.2.3