Define command-line interface

2 files changed, 54 insertions, 21 deletions

diff --git a/src/Fragment.hs b/src/Fragment.hs
index 6850662..249ffb3 100644
--- a/src/Fragment.hs
+++ b/src/Fragment.hs
@@ -14,8 +14,7 @@ this program.  If not, see <http://www.gnu.org/licenses/>. -}
 
 module Fragment ( Fragment(..)
                 , CodeOrReference(..)
-                , parseStdin
-                , parseFile) where
+                , parseFragments) where
 
 import Data.Data (Data)
 import Data.Typeable (Typeable)
@@ -23,7 +22,6 @@ import GHC.Generics (Generic)
 
 import Control.Applicative ((<$>), (<*>))
 import Control.Monad (void)
-import System.IO (hGetContents, stdin)
 import Text.Parsec
 import Text.Parsec.String
 
@@ -35,11 +33,11 @@ data CodeOrReference = Code String
                      | Reference 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
+parseFragments :: FilePath -> String -> Either String [Fragment]
+parseFragments path input =
+  case parse literateFile path input of
+    Right result -> Right result
+    Left err -> Left $ show err
 
 literateFile :: Parser [Fragment]
 literateFile = many (blockCode <|> documentation)
@@ -52,7 +50,7 @@ documentation = do
 blockCode :: Parser Fragment
 blockCode = do
   void $ string "<<"
-  name <- many1Till anyChar (try (string ">>=" <?> "start of code block"))
+  name <- many1Till (noneOf "\r\n") (try (string ">>=" <?> "start of code block"))
   body <- many1Till (reference <|> code) (char '@')
   return $ BlockCode name body
 
diff --git a/src/Main.hs b/src/Main.hs
index 814e26f..fef9a9c 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -12,27 +12,62 @@ 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/>. -}
 
+{-# LANGUAGE LambdaCase #-}
 module Main where
 
+import Data.Data (Data)
+import Data.Typeable (Typeable)
+import GHC.Generics (Generic)
+
+import Data.Functor ((<$>))
 import System.Environment (getArgs)
 import System.Exit (exitFailure)
 
-import Fragment (parseFile, parseStdin)
+import Fragment (parseFragments)
 import Tangle (tangle)
 import Weave (weave)
 
+data Operation = Tangle | Weave
+                  deriving (Eq, Show, Data, Typeable, Generic, Read)
+
+parseOp :: String -> Maybe Operation
+parseOp "tangle" = Just Tangle
+parseOp "weave" = Just Weave
+parseOp _ = Nothing
+
+data Configuration = Configuration Operation (Maybe FilePath)
+                   deriving (Eq, Show, Data, Typeable, Generic)
+
 main :: IO ()
 main = do
-  args <- getArgs
-  parsed <- case args of
-              [] -> parseStdin
-              [f] -> parseFile f
-              _ -> usage >> exitFailure
-  case parsed of
-    Left err -> print err >> exitFailure
-    Right result -> case weave result of
-      Left err -> print err >> exitFailure
-      Right ok -> putStrLn ok
+  processArguments <$> getArgs >>= \case
+    Nothing -> usage >> exitFailure
+    Just (Configuration op file) -> do
+      let pathString = case file of Nothing -> "<stdin>"
+                                    Just path -> path
+      input <- case file of Nothing -> getContents
+                            Just path -> readFile path
+      case doOperation op (pathString, input) of
+        Left err -> putStrLn err >> exitFailure
+        Right result -> putStr result
+
+doOperation :: Operation -> (FilePath, String) -> Either String String
+doOperation op (path, input) = do
+  parsed <- parseFragments path input
+  case op of
+    Tangle -> tangle parsed
+    Weave -> weave parsed
+
+processArguments :: [String] -> Maybe Configuration
+processArguments [opString] =
+  case parseOp opString of
+    Just op -> Just $ Configuration op Nothing
+    Nothing -> Nothing
+processArguments [opString, file] =
+  case parseOp opString of
+    Just op -> Just $ Configuration op (Just file)
+    Nothing -> Nothing
+processArguments _ = Nothing
 
 usage :: IO ()
-usage = putStrLn "usage: lyt [file]"
+usage = putStrLn "usage: lyt (tangle|weave) [file]"