Parse fragments

2 files changed, 67 insertions, 1 deletions

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 <http://www.gnu.org/licenses/>. -}
+
+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 "<stdin>" <$> 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 <http://www.gnu.org/licenses/>. -}
 
 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]"