diff --git a/src/Parse.hs b/src/Parse.hs index 07e4be012..c65973a95 100644 --- a/src/Parse.hs +++ b/src/Parse.hs @@ -11,6 +11,7 @@ import qualified Data.Text.ICU.Convert as Convert import qualified Data.Text.ICU.Detect as Detect import Data.Record import qualified Data.Text as T +import qualified Data.Text.IO as T import Info import Language import Language.Markdown @@ -31,6 +32,34 @@ data ParseJSON = ParseJSON , children :: [ParseJSON] } deriving (Show, Generic, ToJSON) +run2 :: Arguments -> IO () +run2 Arguments{..} = do + sources <- sequence $ readAndTranscodeFile <$> filePaths + terms <- zipWithM (\parser sourceBlob -> parser sourceBlob) parsers (sourceBlobs sources) + + writeToOutput output (cata algebra <$> terms) + + where + sourceBlobs sources = Source.SourceBlob <$> sources <*> pure mempty <*> filePaths <*> pure (Just Source.defaultPlainBlob) + parsers = parserWithSource <$> filePaths + + algebra :: TermF (Syntax leaf) (Record '[SourceText, Range, Category, SourceSpan]) Text -> Text + algebra term = case term of + (annotation :< Leaf _) -> "(" <> category' annotation <> ")" + (annotation :< syntax@(Indexed _)) -> "(" <> category' annotation <> toChildList syntax <> ")" + (annotation :< syntax) -> "\n(" <> category' annotation <> toChildList syntax <> ")" + where + category' = toS . Info.category + toChildList syntax = case toList syntax of + [] -> "" + xs -> " " <> T.unwords xs + + writeToOutput :: Maybe FilePath -> [Text] -> IO () + writeToOutput output text = + case output of + Nothing -> for_ text putStrLn + Just path -> for_ text (T.writeFile path) + run :: Arguments -> IO () run Arguments{..} = do sources <- sequence $ readAndTranscodeFile <$> filePaths diff --git a/src/SemanticDiff.hs b/src/SemanticDiff.hs index 85df97022..748aa3d33 100644 --- a/src/SemanticDiff.hs +++ b/src/SemanticDiff.hs @@ -32,7 +32,7 @@ main = do args@Arguments{..} <- programArguments =<< execParser argumentsParser case runMode of Diff -> runDiff args - Parse -> Parse.run args + Parse -> Parse.run2 args runDiff :: Arguments -> IO () runDiff args@Arguments{..} = case diffMode of