# LANGUAGE CPP #
  | A representation of Haskell source code .
-- 
  Unlike      , our goal is not to reconstruct detailed semantics ,
-- but to preserve original line numbers (if applicable).
module Data.HaskellSource where

import Prelude hiding (fail)

#if MIN_VERSION_base(4,12,0)
import Control.Monad.Fail (fail)
#else
import Prelude (fail)
#endif
import Control.Monad.Trans.Class
import Data.ByteString.Char8 as B
import System.Directory
import System.Exit
import System.Process
import Text.Printf

import Control.Monad.Trans.Uncertain


  | The ByteStrings are original lines , which we never delete in order to
    infer line numbers , while the  were inserted into the original .
type HaskellSource = [Either B.ByteString String]


parseSource :: B.ByteString -> HaskellSource
parseSource = fmap Left . B.lines

-- | A string representation containing line pragmas so that compiler errors
--   are reported about the original file instead of the modified one.
-- 
  > > > let ( x : xs ) = parseSource $ B.pack " import Data . ByteString\nmain = print 42\n "
-- >>> B.putStr $ showSource "orig.hs" (x:xs)
  import Data . ByteString
  main = print 42
-- 
-- >>> B.putStr $ showSource "orig.hs" (x:Right "import Prelude":xs)
  import Data . ByteString
  import Prelude
  { - # LINE 2 " orig.hs " # - }
  main = print 42
showSource :: FilePath -- ^ the original's filename,
                       --   used for fixing up line numbers
           -> HaskellSource -> B.ByteString
showSource orig = B.unlines . go True 1
  where
    go :: Bool -- ^ are line numbers already ok?
       -> Int  -- ^ the original number of the next original line
       -> HaskellSource
       -> [B.ByteString]
    go _     _ []           = []
    go True  i (Left x:xs)  = x
                            : go True (i + 1) xs
    go False i (Left x:xs)  = B.pack (line_marker i)
                            : x
                            : go True (i + 1) xs
    go _     i (Right x:xs) = B.pack x
                            : go False i xs
    
    line_marker :: Int -> String
    line_marker i = printf "{-# LINE %s %s #-}" (show i) (show orig)


readSource :: FilePath -> IO HaskellSource
readSource = fmap parseSource . B.readFile

writeSource :: FilePath -- ^ the original's filename,
                        --   used for fixing up line numbers
            -> FilePath
            -> HaskellSource
            -> IO ()
writeSource orig f = B.writeFile f . showSource orig


compileSource :: FilePath -- ^ the original's filename,
                          --   used for fixing up line numbers
  ^ new filename , because ghc compiles from disk .
                          --   the compiled output will be in the same folder.
              -> HaskellSource
              -> UncertainT IO ()
compileSource = compileSourceWithArgs []

  ^ extra ghc args
                      -> FilePath -- ^ the original's filename,
                                  --   used for fixing up line numbers
  ^ new filename , because ghc compiles from disk .
                                  --   the compiled output will be in the same folder.
                      -> HaskellSource
                      -> UncertainT IO ()
compileSourceWithArgs args orig f s = do
    lift $ writeSource orig f s
    compileFileWithArgs args f


compileFile :: FilePath -> UncertainT IO ()
compileFile = compileFileWithArgs []

compileFileWithArgs :: [String] -> FilePath -> UncertainT IO ()
compileFileWithArgs args f = do
    absFilePath <- lift $ canonicalizePath f
    let args' = absFilePath : "-v0" : args
    (exitCode, out, err) <- lift $ readProcessWithExitCode "ghc" args' ""
    case (exitCode, out ++ err) of
      (ExitSuccess, [])  -> return ()
      (ExitSuccess, _msg) -> return ()  -- TODO: output warnings via 'multilineWarn msg'?
      (_          , [])  -> fail $ printf "could not compile %s" (show f)
      (_          , msg) -> multilineFail msg

 
 but to preserve original line numbers (if applicable).
 | A string representation containing line pragmas so that compiler errors
   are reported about the original file instead of the modified one.
 
 >>> B.putStr $ showSource "orig.hs" (x:xs)
 
 >>> B.putStr $ showSource "orig.hs" (x:Right "import Prelude":xs)
 ^ the original's filename,
   used for fixing up line numbers
 ^ are line numbers already ok?
 ^ the original number of the next original line
 ^ the original's filename,
   used for fixing up line numbers
 ^ the original's filename,
   used for fixing up line numbers
   the compiled output will be in the same folder.
 ^ the original's filename,
   used for fixing up line numbers
   the compiled output will be in the same folder.
 TODO: output warnings via 'multilineWarn msg'?
# LANGUAGE CPP #
  | A representation of Haskell source code .
  Unlike      , our goal is not to reconstruct detailed semantics ,
module Data.HaskellSource where

import Prelude hiding (fail)

#if MIN_VERSION_base(4,12,0)
import Control.Monad.Fail (fail)
#else
import Prelude (fail)
#endif
import Control.Monad.Trans.Class
import Data.ByteString.Char8 as B
import System.Directory
import System.Exit
import System.Process
import Text.Printf

import Control.Monad.Trans.Uncertain


  | The ByteStrings are original lines , which we never delete in order to
    infer line numbers , while the  were inserted into the original .
type HaskellSource = [Either B.ByteString String]


parseSource :: B.ByteString -> HaskellSource
parseSource = fmap Left . B.lines

  > > > let ( x : xs ) = parseSource $ B.pack " import Data . ByteString\nmain = print 42\n "
  import Data . ByteString
  main = print 42
  import Data . ByteString
  import Prelude
  { - # LINE 2 " orig.hs " # - }
  main = print 42
           -> HaskellSource -> B.ByteString
showSource orig = B.unlines . go True 1
  where
       -> HaskellSource
       -> [B.ByteString]
    go _     _ []           = []
    go True  i (Left x:xs)  = x
                            : go True (i + 1) xs
    go False i (Left x:xs)  = B.pack (line_marker i)
                            : x
                            : go True (i + 1) xs
    go _     i (Right x:xs) = B.pack x
                            : go False i xs
    
    line_marker :: Int -> String
    line_marker i = printf "{-# LINE %s %s #-}" (show i) (show orig)


readSource :: FilePath -> IO HaskellSource
readSource = fmap parseSource . B.readFile

            -> FilePath
            -> HaskellSource
            -> IO ()
writeSource orig f = B.writeFile f . showSource orig


  ^ new filename , because ghc compiles from disk .
              -> HaskellSource
              -> UncertainT IO ()
compileSource = compileSourceWithArgs []

  ^ extra ghc args
  ^ new filename , because ghc compiles from disk .
                      -> HaskellSource
                      -> UncertainT IO ()
compileSourceWithArgs args orig f s = do
    lift $ writeSource orig f s
    compileFileWithArgs args f


compileFile :: FilePath -> UncertainT IO ()
compileFile = compileFileWithArgs []

compileFileWithArgs :: [String] -> FilePath -> UncertainT IO ()
compileFileWithArgs args f = do
    absFilePath <- lift $ canonicalizePath f
    let args' = absFilePath : "-v0" : args
    (exitCode, out, err) <- lift $ readProcessWithExitCode "ghc" args' ""
    case (exitCode, out ++ err) of
      (ExitSuccess, [])  -> return ()
      (_          , [])  -> fail $ printf "could not compile %s" (show f)
      (_          , msg) -> multilineFail msg
