summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Fragment.hs16
-rw-r--r--src/Main.hs59
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]"