module Hix.Preproc where

import Control.Lens (IndexedTraversal', has, index, ix, preview, (%~), (.~), (^..))
import Control.Lens.Regex.ByteString (Match, group, groups, match, regex)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (ExceptT, throwE)
import qualified Data.ByteString as ByteString
import Data.ByteString (elemIndex)
import qualified Data.ByteString.Builder as ByteStringBuilder
import Data.ByteString.Builder (Builder, byteString, charUtf8, stringUtf8)
import Data.Generics.Labels ()
import Distribution.PackageDescription (BuildInfo (..))
import Distribution.Simple (PerCompilerFlavor (PerCompilerFlavor))
import qualified Exon
import Exon (exon)
import Language.Haskell.Extension (
  Extension (DisableExtension, EnableExtension, UnknownExtension),
  Language (UnknownLanguage),
  )
import Path (Abs, File, Path, toFilePath)
import Prelude hiding (group)
import System.Random (randomRIO)

import Hix.Cabal (buildInfoForFile)
import Hix.Component (targetComponent)
import qualified Hix.Data.ComponentConfig
import Hix.Data.ComponentConfig (PreludeConfig, PreludePackage (PreludePackageName, PreludePackageSpec))
import Hix.Data.Error (Error (..), sourceError, tryIO)
import qualified Hix.Data.PreprocConfig
import Hix.Data.PreprocConfig (PreprocConfig)
import Hix.Json (jsonConfig)
import Hix.Monad (M)
import Hix.Options (PreprocOptions (..), TargetSpec (TargetForFile))
import Hix.Optparse (JsonConfig)
import qualified Hix.Prelude as Prelude
import Hix.Prelude (Prelude (Prelude), findPrelude)

type Regex = IndexedTraversal' Int ByteString Match

fromPreludeConfig :: PreludeConfig -> Prelude
fromPreludeConfig :: PreludeConfig -> Prelude
fromPreludeConfig PreludeConfig
conf =
  String -> String -> Prelude
Prelude (forall a. ToString a => a -> String
toString (PreludePackage -> Text
name PreludeConfig
conf.package)) (forall a. ToString a => a -> String
toString PreludeConfig
conf.module_.unModuleName)
  where
    name :: PreludePackage -> Text
name = \case
      PreludePackageName Text
n -> Text
n
      PreludePackageSpec Text
n -> Text
n

data CabalConfig =
  CabalConfig {
    CabalConfig -> [Builder]
extensions :: [Builder],
    CabalConfig -> [Builder]
ghcOptions :: [Builder],
    CabalConfig -> Maybe Prelude
prelude :: Maybe Prelude
  }
  deriving stock (Int -> CabalConfig -> ShowS
[CabalConfig] -> ShowS
CabalConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CabalConfig] -> ShowS
$cshowList :: [CabalConfig] -> ShowS
show :: CabalConfig -> String
$cshow :: CabalConfig -> String
showsPrec :: Int -> CabalConfig -> ShowS
$cshowsPrec :: Int -> CabalConfig -> ShowS
Show, forall x. Rep CabalConfig x -> CabalConfig
forall x. CabalConfig -> Rep CabalConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CabalConfig x -> CabalConfig
$cfrom :: forall x. CabalConfig -> Rep CabalConfig x
Generic)

newtype DummyExportName =
  DummyExportName { DummyExportName -> ByteString
unDummyExportName :: ByteString }
  deriving stock (DummyExportName -> DummyExportName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DummyExportName -> DummyExportName -> Bool
$c/= :: DummyExportName -> DummyExportName -> Bool
== :: DummyExportName -> DummyExportName -> Bool
$c== :: DummyExportName -> DummyExportName -> Bool
Eq, Int -> DummyExportName -> ShowS
[DummyExportName] -> ShowS
DummyExportName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DummyExportName] -> ShowS
$cshowList :: [DummyExportName] -> ShowS
show :: DummyExportName -> String
$cshow :: DummyExportName -> String
showsPrec :: Int -> DummyExportName -> ShowS
$cshowsPrec :: Int -> DummyExportName -> ShowS
Show, forall x. Rep DummyExportName x -> DummyExportName
forall x. DummyExportName -> Rep DummyExportName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DummyExportName x -> DummyExportName
$cfrom :: forall x. DummyExportName -> Rep DummyExportName x
Generic)
  deriving newtype (String -> DummyExportName
forall a. (String -> a) -> IsString a
fromString :: String -> DummyExportName
$cfromString :: String -> DummyExportName
IsString, Eq DummyExportName
DummyExportName -> DummyExportName -> Bool
DummyExportName -> DummyExportName -> Ordering
DummyExportName -> DummyExportName -> DummyExportName
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
min :: DummyExportName -> DummyExportName -> DummyExportName
$cmin :: DummyExportName -> DummyExportName -> DummyExportName
max :: DummyExportName -> DummyExportName -> DummyExportName
$cmax :: DummyExportName -> DummyExportName -> DummyExportName
>= :: DummyExportName -> DummyExportName -> Bool
$c>= :: DummyExportName -> DummyExportName -> Bool
> :: DummyExportName -> DummyExportName -> Bool
$c> :: DummyExportName -> DummyExportName -> Bool
<= :: DummyExportName -> DummyExportName -> Bool
$c<= :: DummyExportName -> DummyExportName -> Bool
< :: DummyExportName -> DummyExportName -> Bool
$c< :: DummyExportName -> DummyExportName -> Bool
compare :: DummyExportName -> DummyExportName -> Ordering
$ccompare :: DummyExportName -> DummyExportName -> Ordering
Ord)

noMatch :: Text -> Path b File -> ExceptT Error IO a
noMatch :: forall b a. Text -> Path b File -> ExceptT Error IO a
noMatch Text
reason Path b File
source =
  forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Text -> Error
NoMatch (forall b t. Text -> Path b t -> Text
sourceError Text
reason Path b File
source))

takeLine :: ByteString -> Maybe (ByteString, ByteString)
takeLine :: ByteString -> Maybe (ByteString, ByteString)
takeLine ByteString
bs =
  Word8 -> ByteString -> Maybe Int
elemIndex Word8
10 ByteString
bs forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ Int
i ->
    let (ByteString
xs, ByteString
ys) = Int -> ByteString -> (ByteString, ByteString)
ByteString.splitAt Int
i ByteString
bs
    in (ByteString
xs, HasCallStack => ByteString -> ByteString
ByteString.tail ByteString
ys)

nl :: Builder
nl :: Builder
nl = Char -> Builder
charUtf8 Char
'\n'

lineB :: Builder -> Builder
lineB :: Builder -> Builder
lineB Builder
bs =
  Builder
bs forall a. Semigroup a => a -> a -> a
<> Builder
nl

line :: ByteString -> Builder
line :: ByteString -> Builder
line ByteString
bs =
  Builder -> Builder
lineB (ByteString -> Builder
byteString ByteString
bs)

joinLinesReverse :: [ByteString] -> ByteString
joinLinesReverse :: [ByteString] -> ByteString
joinLinesReverse =
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}. (Semigroup a, IsString a) => a -> a -> a
joinLine forall a. Monoid a => a
mempty
  where
    joinLine :: a -> a -> a
joinLine a
a a
b = a
b forall a. Semigroup a => a -> a -> a
<> a
a forall a. Semigroup a => a -> a -> a
<> a
"\n"

joinLinesReverseBuilder :: [ByteString] -> Builder
joinLinesReverseBuilder :: [ByteString] -> Builder
joinLinesReverseBuilder =
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ByteString -> Builder -> Builder
joinLine forall a. Monoid a => a
mempty
  where
    joinLine :: ByteString -> Builder -> Builder
joinLine ByteString
a Builder
b = Builder
b forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
line ByteString
a

extension :: Extension -> Maybe Builder
extension :: Extension -> Maybe Builder
extension = \case
  EnableExtension KnownExtension
ext -> forall a. a -> Maybe a
Just (forall b a. (Show a, IsString b) => a -> b
show KnownExtension
ext)
  DisableExtension KnownExtension
ext -> forall a. a -> Maybe a
Just (Builder
"No" forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show KnownExtension
ext)
  UnknownExtension String
_ -> forall a. Maybe a
Nothing

languagePragma :: [Builder] -> Builder
languagePragma :: [Builder] -> Builder
languagePragma [Builder]
exts =
  [exon|{-# language #{Exon.intercalate ", " exts} #-}|]

extensionsPragma :: CabalConfig -> Maybe Builder
extensionsPragma :: CabalConfig -> Maybe Builder
extensionsPragma CabalConfig
conf
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null CabalConfig
conf.extensions = forall a. Maybe a
Nothing
  | Bool
otherwise = forall a. a -> Maybe a
Just ([Builder] -> Builder
languagePragma CabalConfig
conf.extensions)

optionsPragma :: Builder -> Builder
optionsPragma :: Builder -> Builder
optionsPragma Builder
opts =
  Builder -> Builder
lineB [exon|{-# options_ghc #{opts} #-}|]

noImplicitPreludeRegex :: Regex
noImplicitPreludeRegex :: Regex
noImplicitPreludeRegex =
  [regex|\bNoImplicitPrelude\b|]

commentRegex :: Regex
commentRegex :: Regex
commentRegex =
  [regex|^\s*--|]

moduleRegex :: Regex
moduleRegex :: Regex
moduleRegex =
  [regex|^\s*module\b\s+(\S+)|]

moduleEndRegex :: Regex
moduleEndRegex :: Regex
moduleEndRegex =
  [regex|\bwhere\b|]

importsEndRegex :: Regex
importsEndRegex :: Regex
importsEndRegex =
  [regex|^\S|]

importRegex :: Regex
importRegex :: Regex
importRegex =
  [regex|^import\b|]

containsNoImplicitPrelude :: ByteString -> Bool
containsNoImplicitPrelude :: ByteString -> Bool
containsNoImplicitPrelude =
  forall s a. Getting Any s a -> s -> Bool
has Regex
noImplicitPreludeRegex

isComment :: ByteString -> Bool
isComment :: ByteString -> Bool
isComment =
  forall s a. Getting Any s a -> s -> Bool
has Regex
commentRegex

isModule :: ByteString -> Maybe ByteString
isModule :: ByteString -> Maybe ByteString
isModule =
  forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Regex
moduleRegex forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IndexedTraversal' ByteString Match ByteString
group Int
0)

isModuleEnd :: ByteString -> Bool
isModuleEnd :: ByteString -> Bool
isModuleEnd =
  forall s a. Getting Any s a -> s -> Bool
has Regex
moduleEndRegex

isImportsEnd :: ByteString -> Bool
isImportsEnd :: ByteString -> Bool
isImportsEnd =
  forall s a. Getting Any s a -> s -> Bool
has Regex
importsEndRegex

isImport :: ByteString -> Bool
isImport :: ByteString -> Bool
isImport =
  forall s a. Getting Any s a -> s -> Bool
has Regex
importRegex

data Phase =
  PreModule
  |
  ModuleStart
  |
  ModuleExports
  |
  Imports
  deriving stock (Phase -> Phase -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Phase -> Phase -> Bool
$c/= :: Phase -> Phase -> Bool
== :: Phase -> Phase -> Bool
$c== :: Phase -> Phase -> Bool
Eq, Int -> Phase -> ShowS
[Phase] -> ShowS
Phase -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Phase] -> ShowS
$cshowList :: [Phase] -> ShowS
show :: Phase -> String
$cshow :: Phase -> String
showsPrec :: Int -> Phase -> ShowS
$cshowsPrec :: Int -> Phase -> ShowS
Show, forall x. Rep Phase x -> Phase
forall x. Phase -> Rep Phase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Phase x -> Phase
$cfrom :: forall x. Phase -> Rep Phase x
Generic)

data PreludeAction =
  PreludeDefault
  |
  PreludeNoImplicit
  |
  PreludeReplaced
  deriving stock (PreludeAction -> PreludeAction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PreludeAction -> PreludeAction -> Bool
$c/= :: PreludeAction -> PreludeAction -> Bool
== :: PreludeAction -> PreludeAction -> Bool
$c== :: PreludeAction -> PreludeAction -> Bool
Eq, Int -> PreludeAction -> ShowS
[PreludeAction] -> ShowS
PreludeAction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PreludeAction] -> ShowS
$cshowList :: [PreludeAction] -> ShowS
show :: PreludeAction -> String
$cshow :: PreludeAction -> String
showsPrec :: Int -> PreludeAction -> ShowS
$cshowsPrec :: Int -> PreludeAction -> ShowS
Show, forall x. Rep PreludeAction x -> PreludeAction
forall x. PreludeAction -> Rep PreludeAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PreludeAction x -> PreludeAction
$cfrom :: forall x. PreludeAction -> Rep PreludeAction x
Generic)

data CustomPrelude =
  CustomPrelude Prelude PreludeAction
  |
  NoCustomPrelude
  deriving stock (Int -> CustomPrelude -> ShowS
[CustomPrelude] -> ShowS
CustomPrelude -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CustomPrelude] -> ShowS
$cshowList :: [CustomPrelude] -> ShowS
show :: CustomPrelude -> String
$cshow :: CustomPrelude -> String
showsPrec :: Int -> CustomPrelude -> ShowS
$cshowsPrec :: Int -> CustomPrelude -> ShowS
Show, forall x. Rep CustomPrelude x -> CustomPrelude
forall x. CustomPrelude -> Rep CustomPrelude x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CustomPrelude x -> CustomPrelude
$cfrom :: forall x. CustomPrelude -> Rep CustomPrelude x
Generic)

notPre :: Phase -> Bool
notPre :: Phase -> Bool
notPre = \case
  Phase
PreModule -> Bool
False
  Phase
_ -> Bool
True

pattern NotPre :: Phase
pattern $mNotPre :: forall {r}. Phase -> ((# #) -> r) -> ((# #) -> r) -> r
NotPre <- (notPre -> True)

inModule :: Phase -> Bool
inModule :: Phase -> Bool
inModule = \case
  Phase
ModuleStart -> Bool
True
  Phase
ModuleExports -> Bool
True
  Phase
_ -> Bool
False

pattern InModule :: Phase
pattern $mInModule :: forall {r}. Phase -> ((# #) -> r) -> ((# #) -> r) -> r
InModule <- (inModule -> True)

preludeRegex :: Regex
preludeRegex :: Regex
preludeRegex =
  [regex|^import\s*((?:"[^"]+" )?\s*)(?:qualified )?\s*(Prelude)|]

replacePrelude :: ByteString -> Prelude -> Maybe ByteString
replacePrelude :: ByteString -> Prelude -> Maybe ByteString
replacePrelude ByteString
l Prelude {String
$sel:preludeModule:Prelude :: Prelude -> String
$sel:preludePackage:Prelude :: Prelude -> String
preludeModule :: String
preludePackage :: String
..}
  | forall s a. Getting Any s a -> s -> Bool
has Regex
preludeRegex ByteString
l =
    forall a. a -> Maybe a
Just (ByteString
l forall a b. a -> (a -> b) -> b
& Regex
preludeRegex forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexedLens' ByteString Match [ByteString]
groups forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ [ByteString] -> [ByteString]
insertPrelude)
  | Bool
otherwise =
    forall a. Maybe a
Nothing
  where
    insertPrelude :: [ByteString] -> [ByteString]
insertPrelude =
      (forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index [ByteString]
0 forall s t a b. ASetter s t a b -> b -> s -> t
.~ [exon|"#{encodeUtf8 preludePackage}" |])
      forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index [ByteString]
1 forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 String
preludeModule)

parenRegex :: Regex
parenRegex :: Regex
parenRegex =
  [regex|(\()|]

dummyExportPlaceholder :: ByteString
dummyExportPlaceholder :: ByteString
dummyExportPlaceholder =
  ByteString
"HIX_DUMMY_EXPORT>"

dummyExportPlaceholderRegex :: Regex
dummyExportPlaceholderRegex :: Regex
dummyExportPlaceholderRegex =
  [regex|HIX_DUMMY_EXPORT>|]

insertExport ::
  ByteString ->
  ByteString
insertExport :: ByteString -> ByteString
insertExport =
  Regex
parenRegex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (p :: * -> * -> *) (f :: * -> *) a.
(Indexable i p, Eq i, Applicative f) =>
i -> Optical' p (Indexed i) f a a
index Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexedTraversal' [ByteString] Match ByteString
match forall s t a b. ASetter s t a b -> b -> s -> t
.~ (ByteString
"(" forall a. Semigroup a => a -> a -> a
<> ByteString
dummyExportPlaceholder)

moduleExportsRegex :: Regex
moduleExportsRegex :: Regex
moduleExportsRegex =
  [regex|\bmodule ([\w.]+)\s*($|,|--|\))|]

moduleExports ::
  ByteString ->
  [ByteString]
moduleExports :: ByteString -> [ByteString]
moduleExports ByteString
l =
  ByteString
l forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Regex
moduleExportsRegex forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IndexedTraversal' ByteString Match ByteString
group Int
0

data Header =
  Header {
    Header -> [ByteString]
moduleLines :: [ByteString],
    Header -> [ByteString]
importLines :: [ByteString],
    Header -> Builder
rest :: Builder,
    Header -> Int
moduleEndLine :: Int,
    Header -> Int
importsEndLine :: Int,
    Header -> CustomPrelude
prelude :: CustomPrelude,
    Header -> Bool
exportsSelf :: Bool
  }
  deriving stock (Int -> Header -> ShowS
[Header] -> ShowS
Header -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Header] -> ShowS
$cshowList :: [Header] -> ShowS
show :: Header -> String
$cshow :: Header -> String
showsPrec :: Int -> Header -> ShowS
$cshowsPrec :: Int -> Header -> ShowS
Show, forall x. Rep Header x -> Header
forall x. Header -> Rep Header x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Header x -> Header
$cfrom :: forall x. Header -> Rep Header x
Generic)

data ScanState =
  ScanState {
    ScanState -> Phase
phase :: Phase,
    ScanState -> [ByteString]
moduleLines :: [ByteString],
    ScanState -> [ByteString]
importLines :: [ByteString],
    ScanState -> Int
moduleLength :: Int,
    ScanState -> Int
importsLength :: Int,
    ScanState -> CustomPrelude
prelude :: CustomPrelude,
    ScanState -> Maybe ByteString
moduleName :: Maybe ByteString,
    ScanState -> Bool
exportsSelf :: Bool
  }
  deriving stock (Int -> ScanState -> ShowS
[ScanState] -> ShowS
ScanState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScanState] -> ShowS
$cshowList :: [ScanState] -> ShowS
show :: ScanState -> String
$cshow :: ScanState -> String
showsPrec :: Int -> ScanState -> ShowS
$cshowsPrec :: Int -> ScanState -> ShowS
Show, forall x. Rep ScanState x -> ScanState
forall x. ScanState -> Rep ScanState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScanState x -> ScanState
$cfrom :: forall x. ScanState -> Rep ScanState x
Generic)

scanHeader ::
  Maybe Prelude ->
  ByteString ->
  Header
scanHeader :: Maybe Prelude -> ByteString -> Header
scanHeader Maybe Prelude
customPrelude =
  ScanState -> ByteString -> Header
tryProcessLine ScanState {
    $sel:phase:ScanState :: Phase
phase = Phase
PreModule,
    $sel:moduleLines:ScanState :: [ByteString]
moduleLines = forall a. Monoid a => a
mempty,
    $sel:importLines:ScanState :: [ByteString]
importLines = forall a. Monoid a => a
mempty,
    $sel:moduleLength:ScanState :: Int
moduleLength = Int
1,
    $sel:importsLength:ScanState :: Int
importsLength = Int
0,
    $sel:prelude:ScanState :: CustomPrelude
prelude = CustomPrelude
initPrelude,
    $sel:moduleName:ScanState :: Maybe ByteString
moduleName = forall a. Maybe a
Nothing,
    $sel:exportsSelf:ScanState :: Bool
exportsSelf = Bool
False
  }
  where
    initPrelude :: CustomPrelude
initPrelude = case Maybe Prelude
customPrelude of
      Just Prelude
p -> Prelude -> PreludeAction -> CustomPrelude
CustomPrelude Prelude
p PreludeAction
PreludeDefault
      Maybe Prelude
Nothing -> CustomPrelude
NoCustomPrelude

    tryProcessLine :: ScanState -> ByteString -> Header
tryProcessLine ScanState
s ByteString
input =
      case ByteString -> Maybe (ByteString, ByteString)
takeLine ByteString
input of
        Just (ByteString
nextLine, ByteString
inputRest) ->
          ScanState -> ByteString -> ByteString -> Header
processLine ScanState
s ByteString
nextLine ByteString
inputRest
        Maybe (ByteString, ByteString)
Nothing ->
          ScanState -> Builder -> Header
finish ScanState
s forall a. Monoid a => a
mempty

    processLine :: ScanState -> ByteString -> ByteString -> Header
processLine ScanState
s ByteString
l ByteString
ls | ByteString -> Bool
isComment ByteString
l Bool -> Bool -> Bool
|| ByteString -> ByteString -> Bool
ByteString.isPrefixOf ByteString
"#" ByteString
l =
      ScanState -> ByteString -> ByteString -> Header
pushCurrent ScanState
s ByteString
l ByteString
ls
    processLine ScanState {$sel:phase:ScanState :: ScanState -> Phase
phase = Phase
PreModule, $sel:prelude:ScanState :: ScanState -> CustomPrelude
prelude = CustomPrelude Prelude
p PreludeAction
PreludeDefault, Bool
Int
[ByteString]
Maybe ByteString
exportsSelf :: Bool
moduleName :: Maybe ByteString
importsLength :: Int
moduleLength :: Int
importLines :: [ByteString]
moduleLines :: [ByteString]
$sel:exportsSelf:ScanState :: ScanState -> Bool
$sel:moduleName:ScanState :: ScanState -> Maybe ByteString
$sel:importsLength:ScanState :: ScanState -> Int
$sel:moduleLength:ScanState :: ScanState -> Int
$sel:importLines:ScanState :: ScanState -> [ByteString]
$sel:moduleLines:ScanState :: ScanState -> [ByteString]
..} ByteString
l ByteString
ls | ByteString -> Bool
containsNoImplicitPrelude ByteString
l =
      ScanState -> ByteString -> ByteString -> Header
pushModule ScanState {$sel:phase:ScanState :: Phase
phase = Phase
PreModule, $sel:prelude:ScanState :: CustomPrelude
prelude = Prelude -> PreludeAction -> CustomPrelude
CustomPrelude Prelude
p PreludeAction
PreludeNoImplicit, Bool
Int
[ByteString]
Maybe ByteString
exportsSelf :: Bool
moduleName :: Maybe ByteString
importsLength :: Int
moduleLength :: Int
importLines :: [ByteString]
moduleLines :: [ByteString]
$sel:exportsSelf:ScanState :: Bool
$sel:moduleName:ScanState :: Maybe ByteString
$sel:importsLength:ScanState :: Int
$sel:moduleLength:ScanState :: Int
$sel:importLines:ScanState :: [ByteString]
$sel:moduleLines:ScanState :: [ByteString]
..} ByteString
l ByteString
ls
    processLine s :: ScanState
s@ScanState {$sel:phase:ScanState :: ScanState -> Phase
phase = Phase
PreModule} ByteString
l ByteString
ls | Just ByteString
name <- ByteString -> Maybe ByteString
isModule ByteString
l =
      ScanState -> Phase -> ByteString -> ByteString -> Header
changePhase (ScanState
s forall a b. a -> (a -> b) -> b
& forall a. IsLabel "moduleName" a => a
#moduleName forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just ByteString
name) Phase
ModuleStart ByteString
l ByteString
ls
    processLine s :: ScanState
s@ScanState {$sel:phase:ScanState :: ScanState -> Phase
phase = Phase
ModuleStart} ByteString
l ByteString
ls | forall s a. Getting Any s a -> s -> Bool
has Regex
parenRegex ByteString
l =
      ScanState -> Phase -> ByteString -> ByteString -> Header
changePhase ScanState
s Phase
ModuleExports (ByteString -> ByteString
insertExport ByteString
l) ByteString
ls
    processLine s :: ScanState
s@ScanState {$sel:phase:ScanState :: ScanState -> Phase
phase = Phase
ModuleExports, $sel:moduleName:ScanState :: ScanState -> Maybe ByteString
moduleName = Just ByteString
name, $sel:exportsSelf:ScanState :: ScanState -> Bool
exportsSelf = Bool
False} ByteString
l ByteString
ls
      | [ByteString]
exs <- ByteString -> [ByteString]
moduleExports ByteString
l
      , forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ByteString
name [ByteString]
exs =
        ScanState -> ByteString -> ByteString -> Header
processLine (ScanState
s forall a b. a -> (a -> b) -> b
& forall a. IsLabel "exportsSelf" a => a
#exportsSelf forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True) ByteString
l ByteString
ls
    processLine ScanState {$sel:phase:ScanState :: ScanState -> Phase
phase = Phase
InModule, Bool
Int
[ByteString]
Maybe ByteString
CustomPrelude
exportsSelf :: Bool
moduleName :: Maybe ByteString
prelude :: CustomPrelude
importsLength :: Int
moduleLength :: Int
importLines :: [ByteString]
moduleLines :: [ByteString]
$sel:exportsSelf:ScanState :: ScanState -> Bool
$sel:moduleName:ScanState :: ScanState -> Maybe ByteString
$sel:prelude:ScanState :: ScanState -> CustomPrelude
$sel:importsLength:ScanState :: ScanState -> Int
$sel:moduleLength:ScanState :: ScanState -> Int
$sel:importLines:ScanState :: ScanState -> [ByteString]
$sel:moduleLines:ScanState :: ScanState -> [ByteString]
..} ByteString
l ByteString
ls | ByteString -> Bool
isModuleEnd ByteString
l =
      ScanState -> ByteString -> ByteString -> Header
pushModule ScanState {$sel:phase:ScanState :: Phase
phase = Phase
Imports, Bool
Int
[ByteString]
Maybe ByteString
CustomPrelude
exportsSelf :: Bool
moduleName :: Maybe ByteString
prelude :: CustomPrelude
importsLength :: Int
moduleLength :: Int
importLines :: [ByteString]
moduleLines :: [ByteString]
$sel:exportsSelf:ScanState :: Bool
$sel:moduleName:ScanState :: Maybe ByteString
$sel:prelude:ScanState :: CustomPrelude
$sel:importsLength:ScanState :: Int
$sel:moduleLength:ScanState :: Int
$sel:importLines:ScanState :: [ByteString]
$sel:moduleLines:ScanState :: [ByteString]
..} ByteString
l ByteString
ls
    processLine s :: ScanState
s@ScanState {$sel:phase:ScanState :: ScanState -> Phase
phase = Phase
InModule} ByteString
l ByteString
ls | ByteString -> Bool
isImport ByteString
l =
      ScanState -> Phase -> ByteString -> ByteString -> Header
changePhase ScanState
s Phase
Imports ByteString
l ByteString
ls
    processLine ScanState {$sel:phase:ScanState :: ScanState -> Phase
phase = Phase
Imports, $sel:prelude:ScanState :: ScanState -> CustomPrelude
prelude = CustomPrelude Prelude
p PreludeAction
action, Bool
Int
[ByteString]
Maybe ByteString
exportsSelf :: Bool
moduleName :: Maybe ByteString
importsLength :: Int
moduleLength :: Int
importLines :: [ByteString]
moduleLines :: [ByteString]
$sel:exportsSelf:ScanState :: ScanState -> Bool
$sel:moduleName:ScanState :: ScanState -> Maybe ByteString
$sel:importsLength:ScanState :: ScanState -> Int
$sel:moduleLength:ScanState :: ScanState -> Int
$sel:importLines:ScanState :: ScanState -> [ByteString]
$sel:moduleLines:ScanState :: ScanState -> [ByteString]
..} ByteString
l ByteString
ls | ByteString -> Bool
isImport ByteString
l =
      let
        (ByteString
replaced, PreludeAction
newAction) =
          case ByteString -> Prelude -> Maybe ByteString
replacePrelude ByteString
l Prelude
p of
            Just ByteString
new -> (ByteString
new, PreludeAction
PreludeReplaced)
            Maybe ByteString
Nothing -> (ByteString
l, PreludeAction
action)
      in ScanState -> ByteString -> ByteString -> Header
pushImport ScanState {$sel:phase:ScanState :: Phase
phase = Phase
Imports, $sel:prelude:ScanState :: CustomPrelude
prelude = Prelude -> PreludeAction -> CustomPrelude
CustomPrelude Prelude
p PreludeAction
newAction, Bool
Int
[ByteString]
Maybe ByteString
exportsSelf :: Bool
moduleName :: Maybe ByteString
importsLength :: Int
moduleLength :: Int
importLines :: [ByteString]
moduleLines :: [ByteString]
$sel:exportsSelf:ScanState :: Bool
$sel:moduleName:ScanState :: Maybe ByteString
$sel:importsLength:ScanState :: Int
$sel:moduleLength:ScanState :: Int
$sel:importLines:ScanState :: [ByteString]
$sel:moduleLines:ScanState :: [ByteString]
..} ByteString
replaced ByteString
ls
    processLine s :: ScanState
s@ScanState {$sel:phase:ScanState :: ScanState -> Phase
phase = Phase
Imports} ByteString
l ByteString
ls | ByteString -> Bool
isImportsEnd ByteString
l =
      ScanState -> Builder -> Header
finish ScanState
s (ByteString -> Builder
line ByteString
l forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
ls)
    processLine ScanState
s ByteString
l ByteString
ls =
      ScanState -> ByteString -> ByteString -> Header
pushCurrent ScanState
s ByteString
l ByteString
ls

    changePhase :: ScanState -> Phase -> ByteString -> ByteString -> Header
changePhase ScanState
s Phase
phase = ScanState -> ByteString -> ByteString -> Header
processLine ScanState
s {Phase
phase :: Phase
$sel:phase:ScanState :: Phase
phase}

    pushCurrent :: ScanState -> ByteString -> ByteString -> Header
pushCurrent s :: ScanState
s@ScanState {Phase
phase :: Phase
$sel:phase:ScanState :: ScanState -> Phase
phase}
      | Phase
Imports <- Phase
phase = ScanState -> ByteString -> ByteString -> Header
pushImport ScanState
s
      | Bool
otherwise = ScanState -> ByteString -> ByteString -> Header
pushModule ScanState
s

    pushModule :: ScanState -> ByteString -> ByteString -> Header
pushModule ScanState {Bool
Int
[ByteString]
Maybe ByteString
CustomPrelude
Phase
exportsSelf :: Bool
moduleName :: Maybe ByteString
prelude :: CustomPrelude
importsLength :: Int
moduleLength :: Int
importLines :: [ByteString]
moduleLines :: [ByteString]
phase :: Phase
$sel:exportsSelf:ScanState :: ScanState -> Bool
$sel:moduleName:ScanState :: ScanState -> Maybe ByteString
$sel:prelude:ScanState :: ScanState -> CustomPrelude
$sel:importsLength:ScanState :: ScanState -> Int
$sel:moduleLength:ScanState :: ScanState -> Int
$sel:importLines:ScanState :: ScanState -> [ByteString]
$sel:moduleLines:ScanState :: ScanState -> [ByteString]
$sel:phase:ScanState :: ScanState -> Phase
..} ByteString
l =
      ScanState -> ByteString -> Header
tryProcessLine ScanState {
        $sel:moduleLines:ScanState :: [ByteString]
moduleLines = ByteString
l forall a. a -> [a] -> [a]
: [ByteString]
moduleLines,
        $sel:moduleLength:ScanState :: Int
moduleLength = Int
moduleLength forall a. Num a => a -> a -> a
+ Int
1,
        Bool
Int
[ByteString]
Maybe ByteString
CustomPrelude
Phase
exportsSelf :: Bool
moduleName :: Maybe ByteString
prelude :: CustomPrelude
importsLength :: Int
importLines :: [ByteString]
phase :: Phase
$sel:exportsSelf:ScanState :: Bool
$sel:moduleName:ScanState :: Maybe ByteString
$sel:prelude:ScanState :: CustomPrelude
$sel:importsLength:ScanState :: Int
$sel:importLines:ScanState :: [ByteString]
$sel:phase:ScanState :: Phase
..
      }

    pushImport :: ScanState -> ByteString -> ByteString -> Header
pushImport ScanState {Bool
Int
[ByteString]
Maybe ByteString
CustomPrelude
Phase
exportsSelf :: Bool
moduleName :: Maybe ByteString
prelude :: CustomPrelude
importsLength :: Int
moduleLength :: Int
importLines :: [ByteString]
moduleLines :: [ByteString]
phase :: Phase
$sel:exportsSelf:ScanState :: ScanState -> Bool
$sel:moduleName:ScanState :: ScanState -> Maybe ByteString
$sel:prelude:ScanState :: ScanState -> CustomPrelude
$sel:importsLength:ScanState :: ScanState -> Int
$sel:moduleLength:ScanState :: ScanState -> Int
$sel:importLines:ScanState :: ScanState -> [ByteString]
$sel:moduleLines:ScanState :: ScanState -> [ByteString]
$sel:phase:ScanState :: ScanState -> Phase
..} ByteString
l =
      ScanState -> ByteString -> Header
tryProcessLine ScanState {$sel:importLines:ScanState :: [ByteString]
importLines = ByteString
l forall a. a -> [a] -> [a]
: [ByteString]
importLines, $sel:importsLength:ScanState :: Int
importsLength = Int
importsLength forall a. Num a => a -> a -> a
+ Int
1, Bool
Int
[ByteString]
Maybe ByteString
CustomPrelude
Phase
exportsSelf :: Bool
moduleName :: Maybe ByteString
prelude :: CustomPrelude
moduleLength :: Int
moduleLines :: [ByteString]
phase :: Phase
$sel:exportsSelf:ScanState :: Bool
$sel:moduleName:ScanState :: Maybe ByteString
$sel:prelude:ScanState :: CustomPrelude
$sel:moduleLength:ScanState :: Int
$sel:moduleLines:ScanState :: [ByteString]
$sel:phase:ScanState :: Phase
..}

    finish :: ScanState -> Builder -> Header
finish ScanState {Bool
Int
[ByteString]
Maybe ByteString
CustomPrelude
Phase
exportsSelf :: Bool
moduleName :: Maybe ByteString
prelude :: CustomPrelude
importsLength :: Int
moduleLength :: Int
importLines :: [ByteString]
moduleLines :: [ByteString]
phase :: Phase
$sel:exportsSelf:ScanState :: ScanState -> Bool
$sel:moduleName:ScanState :: ScanState -> Maybe ByteString
$sel:prelude:ScanState :: ScanState -> CustomPrelude
$sel:importsLength:ScanState :: ScanState -> Int
$sel:moduleLength:ScanState :: ScanState -> Int
$sel:importLines:ScanState :: ScanState -> [ByteString]
$sel:moduleLines:ScanState :: ScanState -> [ByteString]
$sel:phase:ScanState :: ScanState -> Phase
..} Builder
rest =
      Header {
        $sel:moduleEndLine:Header :: Int
moduleEndLine = Int
moduleLength,
        $sel:importsEndLine:Header :: Int
importsEndLine = Int
moduleLength forall a. Num a => a -> a -> a
+ Int
importsLength,
        Bool
[ByteString]
Builder
CustomPrelude
rest :: Builder
exportsSelf :: Bool
prelude :: CustomPrelude
importLines :: [ByteString]
moduleLines :: [ByteString]
$sel:exportsSelf:Header :: Bool
$sel:prelude:Header :: CustomPrelude
$sel:rest:Header :: Builder
$sel:importLines:Header :: [ByteString]
$sel:moduleLines:Header :: [ByteString]
..
      }

customPreludeImport :: Prelude -> Builder
customPreludeImport :: Prelude -> Builder
customPreludeImport Prelude {String
preludeModule :: String
preludePackage :: String
$sel:preludeModule:Prelude :: Prelude -> String
$sel:preludePackage:Prelude :: Prelude -> String
..} =
  Builder -> Builder
lineB [exon|import "#{stringUtf8 preludePackage}" #{stringUtf8 preludeModule} as Prelude|]

needPreludeExtensions :: PreludeAction -> Bool
needPreludeExtensions :: PreludeAction -> Bool
needPreludeExtensions = \case
  PreludeAction
PreludeDefault -> Bool
True
  PreludeAction
PreludeNoImplicit -> Bool
False
  PreludeAction
PreludeReplaced -> Bool
True

pattern NeedPreludeExtensions :: PreludeAction
pattern $mNeedPreludeExtensions :: forall {r}. PreludeAction -> ((# #) -> r) -> ((# #) -> r) -> r
NeedPreludeExtensions <- (needPreludeExtensions -> True)

needDummy :: CustomPrelude -> Bool
needDummy :: CustomPrelude -> Bool
needDummy = \case
  CustomPrelude
NoCustomPrelude -> Bool
False
  CustomPrelude Prelude
_ PreludeAction
action -> PreludeAction -> Bool
needPreludeExtensions PreludeAction
action

pattern NeedDummy :: CustomPrelude
pattern $mNeedDummy :: forall {r}. CustomPrelude -> ((# #) -> r) -> ((# #) -> r) -> r
NeedDummy <- (needDummy -> True)

preludeExtensions :: CustomPrelude -> Builder
preludeExtensions :: CustomPrelude -> Builder
preludeExtensions = \case
  CustomPrelude Prelude
_ PreludeAction
NeedPreludeExtensions ->
    Builder -> Builder
lineB ([Builder] -> Builder
languagePragma [Builder
"PackageImports", Builder
"NoImplicitPrelude"])
  CustomPrelude
_ ->
    forall a. Monoid a => a
mempty

explicitPreludeImport ::
  Builder ->
  CustomPrelude ->
  Builder
explicitPreludeImport :: Builder -> CustomPrelude -> Builder
explicitPreludeImport Builder
lineNo = \case
  CustomPrelude Prelude
prelude PreludeAction
PreludeDefault -> Prelude -> Builder
customPreludeImport Prelude
prelude forall a. Semigroup a => a -> a -> a
<> Builder
lineNo
  CustomPrelude
_ -> forall a. Monoid a => a
mempty

dummyDecl ::
  CustomPrelude ->
  Builder ->
  DummyExportName ->
  Builder
dummyDecl :: CustomPrelude -> Builder -> DummyExportName -> Builder
dummyDecl CustomPrelude
NeedDummy Builder
lineNo (DummyExportName ByteString
n) =
  Builder -> Builder
lineB [exon|type #{byteString n} = Int|] forall a. Semigroup a => a -> a -> a
<> Builder
lineNo
dummyDecl CustomPrelude
_ Builder
_ DummyExportName
_ =
  forall a. Monoid a => a
mempty

replaceDummy ::
  CustomPrelude ->
  Bool ->
  DummyExportName ->
  ByteString ->
  ByteString
replaceDummy :: CustomPrelude
-> Bool -> DummyExportName -> ByteString -> ByteString
replaceDummy CustomPrelude
NeedDummy Bool
False (DummyExportName ByteString
n) =
  Regex
dummyExportPlaceholderRegex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (p :: * -> * -> *) (f :: * -> *) a.
(Indexable i p, Eq i, Applicative f) =>
i -> Optical' p (Indexed i) f a a
index Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexedTraversal' [ByteString] Match ByteString
match forall s t a b. ASetter s t a b -> b -> s -> t
.~ [exon|#{n},|]
replaceDummy CustomPrelude
_ Bool
_ DummyExportName
_ =
  Regex
dummyExportPlaceholderRegex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (p :: * -> * -> *) (f :: * -> *) a.
(Indexable i p, Eq i, Applicative f) =>
i -> Optical' p (Indexed i) f a a
index Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexedTraversal' [ByteString] Match ByteString
match forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString
""

assemble ::
  Path Abs File ->
  Header ->
  Maybe Builder ->
  Maybe Builder ->
  DummyExportName ->
  Builder
assemble :: Path Abs File
-> Header
-> Maybe Builder
-> Maybe Builder
-> DummyExportName
-> Builder
assemble Path Abs File
source Header {Bool
Int
[ByteString]
Builder
CustomPrelude
exportsSelf :: Bool
prelude :: CustomPrelude
importsEndLine :: Int
moduleEndLine :: Int
rest :: Builder
importLines :: [ByteString]
moduleLines :: [ByteString]
$sel:exportsSelf:Header :: Header -> Bool
$sel:prelude:Header :: Header -> CustomPrelude
$sel:importsEndLine:Header :: Header -> Int
$sel:moduleEndLine:Header :: Header -> Int
$sel:rest:Header :: Header -> Builder
$sel:importLines:Header :: Header -> [ByteString]
$sel:moduleLines:Header :: Header -> [ByteString]
..} Maybe Builder
exts Maybe Builder
options DummyExportName
dummyExportName =
  forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Builder -> Builder
optionsPragma Maybe Builder
options forall a. Semigroup a => a -> a -> a
<>
  forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Builder -> Builder
lineB Maybe Builder
exts forall a. Semigroup a => a -> a -> a
<>
  CustomPrelude -> Builder
preludeExtensions CustomPrelude
prelude forall a. Semigroup a => a -> a -> a
<>
  Int -> Builder
linePragma Int
1 forall a. Semigroup a => a -> a -> a
<>
  ByteString -> Builder
byteString (CustomPrelude
-> Bool -> DummyExportName -> ByteString -> ByteString
replaceDummy CustomPrelude
prelude Bool
exportsSelf DummyExportName
dummyExportName ByteString
moduleString) forall a. Semigroup a => a -> a -> a
<>
  Builder -> CustomPrelude -> Builder
explicitPreludeImport (Int -> Builder
linePragma Int
moduleEndLine) CustomPrelude
prelude forall a. Semigroup a => a -> a -> a
<>
  Builder
importsString forall a. Semigroup a => a -> a -> a
<>
  CustomPrelude -> Builder -> DummyExportName -> Builder
dummyDecl CustomPrelude
prelude (Int -> Builder
linePragma Int
importsEndLine) DummyExportName
dummyExportName forall a. Semigroup a => a -> a -> a
<>
  Builder
rest
  where
    linePragma :: Int -> Builder
linePragma Int
n =
      Builder -> Builder
lineB [exon|{-# line #{show n} "#{stringUtf8 (toFilePath source)}" #-}|]
    moduleString :: ByteString
moduleString = [ByteString] -> ByteString
joinLinesReverse [ByteString]
moduleLines
    importsString :: Builder
importsString = [ByteString] -> Builder
joinLinesReverseBuilder [ByteString]
importLines

preprocessModule ::
  Path Abs File ->
  CabalConfig ->
  DummyExportName ->
  ByteString ->
  Builder
preprocessModule :: Path Abs File
-> CabalConfig -> DummyExportName -> ByteString -> Builder
preprocessModule Path Abs File
source CabalConfig
conf DummyExportName
dummyExportName ByteString
inLines =
  Path Abs File
-> Header
-> Maybe Builder
-> Maybe Builder
-> DummyExportName
-> Builder
assemble Path Abs File
source Header
header (CabalConfig -> Maybe Builder
extensionsPragma CabalConfig
conf) Maybe Builder
options DummyExportName
dummyExportName
  where
    options :: Maybe Builder
options = forall a (t :: * -> *). (Monoid a, Foldable t) => a -> t a -> a
Exon.intercalate Builder
" " forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe (NonEmpty a)
nonEmpty CabalConfig
conf.ghcOptions
    header :: Header
header = Maybe Prelude -> ByteString -> Header
scanHeader CabalConfig
conf.prelude ByteString
inLines

preprocessWith :: PreprocOptions -> CabalConfig -> M ()
preprocessWith :: PreprocOptions -> CabalConfig -> M ()
preprocessWith PreprocOptions
opt CabalConfig
conf = do
  ByteString
inLines <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall a. IO a -> ExceptT Error IO a
tryIO (String -> IO ByteString
ByteString.readFile (forall b t. Path b t -> String
toFilePath PreprocOptions
opt.inFile)))
  Int
dummyNumber :: Int <- forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
10000, Int
10000000)
  let dummyExportName :: DummyExportName
dummyExportName = ByteString -> DummyExportName
DummyExportName [exon|Hix_Dummy_#{show dummyNumber}|]
  let result :: Builder
result = Path Abs File
-> CabalConfig -> DummyExportName -> ByteString -> Builder
preprocessModule PreprocOptions
opt.source CabalConfig
conf DummyExportName
dummyExportName ByteString
inLines
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall a. IO a -> ExceptT Error IO a
tryIO (String -> Builder -> IO ()
ByteStringBuilder.writeFile (forall b t. Path b t -> String
toFilePath PreprocOptions
opt.outFile) Builder
result))

fromConfig :: Path Abs File -> Either PreprocConfig JsonConfig -> M CabalConfig
fromConfig :: Path Abs File -> Either PreprocConfig JsonConfig -> M CabalConfig
fromConfig Path Abs File
source Either PreprocConfig JsonConfig
pconf = do
  PreprocConfig
conf <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. FromJSON a => JsonConfig -> M a
jsonConfig Either PreprocConfig JsonConfig
pconf
  Target
target <- PackagesConfig -> TargetSpec -> M Target
targetComponent PreprocConfig
conf.packages (Path Abs File -> TargetSpec
TargetForFile Path Abs File
source)
  pure CabalConfig {
    $sel:extensions:CabalConfig :: [Builder]
extensions = String -> Builder
stringUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Target
target.component.language forall a. a -> [a] -> [a]
: Target
target.component.extensions,
    $sel:ghcOptions:CabalConfig :: [Builder]
ghcOptions = String -> Builder
stringUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Target
target.component.ghcOptions,
    $sel:prelude:CabalConfig :: Maybe Prelude
prelude = PreludeConfig -> Prelude
fromPreludeConfig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Target
target.component.prelude
    }

fromCabal :: BuildInfo -> CabalConfig
fromCabal :: BuildInfo -> CabalConfig
fromCabal BuildInfo
info =
  CabalConfig {
    $sel:extensions:CabalConfig :: [Builder]
extensions = forall a. Maybe a -> [a]
maybeToList (Language -> Maybe Builder
dlExtension forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BuildInfo
info.defaultLanguage) forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Extension -> Maybe Builder
extension BuildInfo
info.defaultExtensions,
    $sel:ghcOptions:CabalConfig :: [Builder]
ghcOptions = String -> Builder
stringUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
ghcOptions,
    $sel:prelude:CabalConfig :: Maybe Prelude
prelude = [Mixin] -> Maybe Prelude
findPrelude BuildInfo
info.mixins
    }
  where
    PerCompilerFlavor [String]
ghcOptions [String]
_ = BuildInfo
info.options
    dlExtension :: Language -> Maybe Builder
dlExtension = \case
      UnknownLanguage String
_ -> forall a. Maybe a
Nothing
      Language
lang -> forall a. a -> Maybe a
Just (String -> Builder
stringUtf8 (forall b a. (Show a, IsString b) => a -> b
show Language
lang))

fromCabalFile :: Path Abs File -> M CabalConfig
fromCabalFile :: Path Abs File -> M CabalConfig
fromCabalFile Path Abs File
source =
  BuildInfo -> CabalConfig
fromCabal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Path Abs File -> ExceptT Error IO BuildInfo
buildInfoForFile Path Abs File
source)

-- TODO add common stanzas
preprocess :: PreprocOptions -> M ()
preprocess :: PreprocOptions -> M ()
preprocess PreprocOptions
opt = do
  CabalConfig
conf <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Path Abs File -> M CabalConfig
fromCabalFile PreprocOptions
opt.source) (Path Abs File -> Either PreprocConfig JsonConfig -> M CabalConfig
fromConfig PreprocOptions
opt.source) PreprocOptions
opt.config
  PreprocOptions -> CabalConfig -> M ()
preprocessWith PreprocOptions
opt CabalConfig
conf