{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
module Distribution.Simple.PreProcess.Types
( Suffix (..)
, PreProcessor (..)
, builtinHaskellSuffixes
, builtinHaskellBootSuffixes
)
where
import Distribution.Compat.Prelude
import Prelude ()
import Distribution.ModuleName (ModuleName)
import Distribution.Pretty
import Distribution.Verbosity
import qualified Text.PrettyPrint as Disp
data PreProcessor = PreProcessor
{
PreProcessor -> Bool
platformIndependent :: Bool
,
PreProcessor
-> Verbosity -> [FilePath] -> [ModuleName] -> IO [ModuleName]
ppOrdering
:: Verbosity
-> [FilePath]
-> [ModuleName]
-> IO [ModuleName]
, PreProcessor
-> (FilePath, FilePath)
-> (FilePath, FilePath)
-> Verbosity
-> IO ()
runPreProcessor
:: (FilePath, FilePath)
-> (FilePath, FilePath)
-> Verbosity
-> IO ()
}
newtype Suffix = Suffix String
deriving (Suffix -> Suffix -> Bool
(Suffix -> Suffix -> Bool)
-> (Suffix -> Suffix -> Bool) -> Eq Suffix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Suffix -> Suffix -> Bool
== :: Suffix -> Suffix -> Bool
$c/= :: Suffix -> Suffix -> Bool
/= :: Suffix -> Suffix -> Bool
Eq, Eq Suffix
Eq Suffix =>
(Suffix -> Suffix -> Ordering)
-> (Suffix -> Suffix -> Bool)
-> (Suffix -> Suffix -> Bool)
-> (Suffix -> Suffix -> Bool)
-> (Suffix -> Suffix -> Bool)
-> (Suffix -> Suffix -> Suffix)
-> (Suffix -> Suffix -> Suffix)
-> Ord Suffix
Suffix -> Suffix -> Bool
Suffix -> Suffix -> Ordering
Suffix -> Suffix -> Suffix
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Suffix -> Suffix -> Ordering
compare :: Suffix -> Suffix -> Ordering
$c< :: Suffix -> Suffix -> Bool
< :: Suffix -> Suffix -> Bool
$c<= :: Suffix -> Suffix -> Bool
<= :: Suffix -> Suffix -> Bool
$c> :: Suffix -> Suffix -> Bool
> :: Suffix -> Suffix -> Bool
$c>= :: Suffix -> Suffix -> Bool
>= :: Suffix -> Suffix -> Bool
$cmax :: Suffix -> Suffix -> Suffix
max :: Suffix -> Suffix -> Suffix
$cmin :: Suffix -> Suffix -> Suffix
min :: Suffix -> Suffix -> Suffix
Ord, Int -> Suffix -> FilePath -> FilePath
[Suffix] -> FilePath -> FilePath
Suffix -> FilePath
(Int -> Suffix -> FilePath -> FilePath)
-> (Suffix -> FilePath)
-> ([Suffix] -> FilePath -> FilePath)
-> Show Suffix
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> Suffix -> FilePath -> FilePath
showsPrec :: Int -> Suffix -> FilePath -> FilePath
$cshow :: Suffix -> FilePath
show :: Suffix -> FilePath
$cshowList :: [Suffix] -> FilePath -> FilePath
showList :: [Suffix] -> FilePath -> FilePath
Show, (forall x. Suffix -> Rep Suffix x)
-> (forall x. Rep Suffix x -> Suffix) -> Generic Suffix
forall x. Rep Suffix x -> Suffix
forall x. Suffix -> Rep Suffix x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Suffix -> Rep Suffix x
from :: forall x. Suffix -> Rep Suffix x
$cto :: forall x. Rep Suffix x -> Suffix
to :: forall x. Rep Suffix x -> Suffix
Generic, FilePath -> Suffix
(FilePath -> Suffix) -> IsString Suffix
forall a. (FilePath -> a) -> IsString a
$cfromString :: FilePath -> Suffix
fromString :: FilePath -> Suffix
IsString)
instance Pretty Suffix where
pretty :: Suffix -> Doc
pretty (Suffix FilePath
s) = FilePath -> Doc
Disp.text FilePath
s
instance Binary Suffix
instance Structured Suffix
builtinHaskellSuffixes :: [Suffix]
builtinHaskellSuffixes :: [Suffix]
builtinHaskellSuffixes = (FilePath -> Suffix) -> [FilePath] -> [Suffix]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Suffix
Suffix [FilePath
"hs", FilePath
"lhs", FilePath
"hsig", FilePath
"lhsig"]
builtinHaskellBootSuffixes :: [Suffix]
builtinHaskellBootSuffixes :: [Suffix]
builtinHaskellBootSuffixes = (FilePath -> Suffix) -> [FilePath] -> [Suffix]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Suffix
Suffix [FilePath
"hs-boot", FilePath
"lhs-boot"]