diff options
| -rw-r--r-- | src/Fragment.hs | 16 | ||||
| -rw-r--r-- | src/Main.hs | 59 |
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]" |