Parse.hs

-- | Organizes and combines all the parse phases.
module Descript.Build.Read.Parse
  ( parse
  , parseTest
  , parseInputVal
  , parseOutputVal
  ) where

import qualified Descript.Sugar.Data.Value.In as Sugar.In
import qualified Descript.Sugar.Data.Value.Out as Sugar.Out
import qualified Descript.Sugar as Sugar
import qualified Descript.Free as Free
import qualified Descript.Lex as Lex
import Descript.Misc
import Control.Arrow

-- | Parses a source file.
parse :: SFile -> ParseResult (Sugar.Source SrcAnn)
parse file
    = fmap fixAnn
    . Sugar.parse file
  =<< Free.parse file
  =<< Lex.parse file

-- | Parses a source file, inspecting each phase and discarding the
-- inspection result. The first string is the literal name of the phase,
-- the second contains its reduce print and summary. Useful for testing
-- phases.
parseTest :: (Monad w)
          => SFile
          -> (String -> ParseResult (String, String) -> w ())
          -> ParseResultT w (Sugar.Source SrcAnn)
parseTest file test
    = fmap fixAnn
    . phase "Sugar" Sugar.parse reducePrint
  =<< phase "Free" Free.parse reducePrintF
  =<< phase "Lex" Lex.parse_ reducePrintF ()
  where phase name' parse' reducePrint' prev = ResultT $ do
          let next = parse' file prev
          test name' $ mapSuccess (reducePrint' &&& summary) next
          pure next

parseInputVal :: SFile -> ParseResult (Sugar.In.Value SrcAnn)
parseInputVal file
    = fmap fixAnn
    . Sugar.parseInputVal file
  =<< Free.parseValue file
  =<< Lex.parse file

parseOutputVal :: SFile -> ParseResult (Sugar.Out.Value SrcAnn)
parseOutputVal file
    = fmap fixAnn
    . Sugar.parseOutputVal file
  =<< Free.parseValue file
  =<< Lex.parse file

fixAnn :: (Ann wr) => wr Range -> wr SrcAnn
fixAnn = fmap parsedSrcAnn