-- Copyright (c) Facebook, Inc. and its affiliates.
--
-- This source code is licensed under the MIT license found in the
-- LICENSE file in the root directory of this source tree.
--
{-# LANGUAGE ApplicativeDo #-}
module Retrie.Debug
  ( RoundTrip(..)
  , parseRoundtrips
  , doRoundtrips
  ) where

import Options.Applicative
import System.FilePath

import Retrie.CPP
import Retrie.ExactPrint
import Retrie.Fixity

data RoundTrip = RoundTrip Bool FilePath {- True = with fixities -}

parseRoundtrips :: Parser [RoundTrip]
parseRoundtrips :: Parser [RoundTrip]
parseRoundtrips = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
  [ Bool -> FilePath -> RoundTrip
RoundTrip Bool
True forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall s. IsString s => ReadM s
str
      (  forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"roundtrip" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PATH"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Roundtrip file through ghc-exactprint and fixity adjustment.")
  , Bool -> FilePath -> RoundTrip
RoundTrip Bool
False forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall s. IsString s => ReadM s
str
      (  forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"roundtrip-no-fixity" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PATH"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Roundtrip file through ghc-exactprint only.")
  ]

doRoundtrips :: LibDir -> FixityEnv -> FilePath -> [RoundTrip] -> IO ()
doRoundtrips :: FilePath -> FixityEnv -> FilePath -> [RoundTrip] -> IO ()
doRoundtrips FilePath
libdir FixityEnv
fixities FilePath
targetDir = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a b. (a -> b) -> a -> b
$ \ (RoundTrip Bool
doFix FilePath
fp) -> do
  let path :: FilePath
path = FilePath
targetDir FilePath -> FilePath -> FilePath
</> FilePath
fp
  CPP AnnotatedModule
cpp <-
    if Bool
doFix
    then (FilePath -> FilePath -> IO AnnotatedModule)
-> FilePath -> IO (CPP AnnotatedModule)
parseCPPFile (FilePath -> FixityEnv -> FilePath -> FilePath -> IO AnnotatedModule
parseContent FilePath
libdir FixityEnv
fixities) FilePath
path
    else (FilePath -> FilePath -> IO AnnotatedModule)
-> FilePath -> IO (CPP AnnotatedModule)
parseCPPFile (FilePath -> FilePath -> FilePath -> IO AnnotatedModule
parseContentNoFixity FilePath
libdir) FilePath
path
  FilePath -> FilePath -> IO ()
writeFile FilePath
path forall a b. (a -> b) -> a -> b
$ [Replacement] -> CPP AnnotatedModule -> FilePath
printCPP [] CPP AnnotatedModule
cpp