{-# 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
parseRoundtrips :: Parser [RoundTrip]
parseRoundtrips :: Parser [RoundTrip]
parseRoundtrips = [[RoundTrip]] -> [RoundTrip]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[RoundTrip]] -> [RoundTrip])
-> Parser [[RoundTrip]] -> Parser [RoundTrip]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser RoundTrip -> Parser [RoundTrip])
-> [Parser RoundTrip] -> Parser [[RoundTrip]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Parser RoundTrip -> Parser [RoundTrip]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
[ Bool -> FilePath -> RoundTrip
RoundTrip Bool
True (FilePath -> RoundTrip) -> Parser FilePath -> Parser RoundTrip
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FilePath
forall s. IsString s => ReadM s
str
( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"roundtrip" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PATH"
Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Roundtrip file through ghc-exactprint and fixity adjustment.")
, Bool -> FilePath -> RoundTrip
RoundTrip Bool
False (FilePath -> RoundTrip) -> Parser FilePath -> Parser RoundTrip
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FilePath
forall s. IsString s => ReadM s
str
( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"roundtrip-no-fixity" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PATH"
Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
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 = (RoundTrip -> IO ()) -> [RoundTrip] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((RoundTrip -> IO ()) -> [RoundTrip] -> IO ())
-> (RoundTrip -> IO ()) -> [RoundTrip] -> IO ()
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 (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [Replacement] -> CPP AnnotatedModule -> FilePath
printCPP [] CPP AnnotatedModule
cpp