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 qualified Data.Map.Strict as Map
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, Dir, File, Path, toFilePath)
import Prelude hiding (group)
import System.Random (randomRIO)

import Hix.Cabal (buildInfoForFile)
import Hix.Component (targetComponentOrError)
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

-- TODO do we need to parse the spec here?
fromPreludeConfig :: PreprocConfig -> PreludeConfig -> Prelude
fromPreludeConfig :: PreprocConfig -> PreludeConfig -> Prelude
fromPreludeConfig PreprocConfig
ppconf PreludeConfig
conf =
  String -> String -> Bool -> Prelude
Prelude (Text -> String
forall a. ToString a => a -> String
toString Text
name) (Text -> String
forall a. ToString a => a -> String
toString PreludeConfig
conf.module_.unModuleName) Bool
local
  where
    local :: Bool
local = PackageName -> Map PackageName PackageConfig -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member (Text -> PackageName
forall a b. Coercible a b => a -> b
coerce Text
name) PreprocConfig
ppconf.packages
    name :: Text
name = case PreludeConfig
conf.package of
      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
(Int -> CabalConfig -> ShowS)
-> (CabalConfig -> String)
-> ([CabalConfig] -> ShowS)
-> Show CabalConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CabalConfig -> ShowS
showsPrec :: Int -> CabalConfig -> ShowS
$cshow :: CabalConfig -> String
show :: CabalConfig -> String
$cshowList :: [CabalConfig] -> ShowS
showList :: [CabalConfig] -> ShowS
Show, (forall x. CabalConfig -> Rep CabalConfig x)
-> (forall x. Rep CabalConfig x -> CabalConfig)
-> Generic CabalConfig
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
$cfrom :: forall x. CabalConfig -> Rep CabalConfig x
from :: forall x. CabalConfig -> Rep CabalConfig x
$cto :: forall x. Rep CabalConfig x -> CabalConfig
to :: forall x. Rep CabalConfig x -> CabalConfig
Generic)

newtype DummyExportName =
  DummyExportName { DummyExportName -> ByteString
unDummyExportName :: ByteString }
  deriving stock (DummyExportName -> DummyExportName -> Bool
(DummyExportName -> DummyExportName -> Bool)
-> (DummyExportName -> DummyExportName -> Bool)
-> Eq DummyExportName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DummyExportName -> DummyExportName -> Bool
== :: DummyExportName -> DummyExportName -> Bool
$c/= :: DummyExportName -> DummyExportName -> Bool
/= :: DummyExportName -> DummyExportName -> Bool
Eq, Int -> DummyExportName -> ShowS
[DummyExportName] -> ShowS
DummyExportName -> String
(Int -> DummyExportName -> ShowS)
-> (DummyExportName -> String)
-> ([DummyExportName] -> ShowS)
-> Show DummyExportName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DummyExportName -> ShowS
showsPrec :: Int -> DummyExportName -> ShowS
$cshow :: DummyExportName -> String
show :: DummyExportName -> String
$cshowList :: [DummyExportName] -> ShowS
showList :: [DummyExportName] -> ShowS
Show, (forall x. DummyExportName -> Rep DummyExportName x)
-> (forall x. Rep DummyExportName x -> DummyExportName)
-> Generic DummyExportName
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
$cfrom :: forall x. DummyExportName -> Rep DummyExportName x
from :: forall x. DummyExportName -> Rep DummyExportName x
$cto :: forall x. Rep DummyExportName x -> DummyExportName
to :: forall x. Rep DummyExportName x -> DummyExportName
Generic)
  deriving newtype (String -> DummyExportName
(String -> DummyExportName) -> IsString DummyExportName
forall a. (String -> a) -> IsString a
$cfromString :: String -> DummyExportName
fromString :: String -> DummyExportName
IsString, Eq DummyExportName
Eq DummyExportName
-> (DummyExportName -> DummyExportName -> Ordering)
-> (DummyExportName -> DummyExportName -> Bool)
-> (DummyExportName -> DummyExportName -> Bool)
-> (DummyExportName -> DummyExportName -> Bool)
-> (DummyExportName -> DummyExportName -> Bool)
-> (DummyExportName -> DummyExportName -> DummyExportName)
-> (DummyExportName -> DummyExportName -> DummyExportName)
-> Ord 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
$ccompare :: DummyExportName -> DummyExportName -> Ordering
compare :: DummyExportName -> DummyExportName -> Ordering
$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
>= :: DummyExportName -> DummyExportName -> Bool
$cmax :: DummyExportName -> DummyExportName -> DummyExportName
max :: DummyExportName -> DummyExportName -> DummyExportName
$cmin :: DummyExportName -> DummyExportName -> DummyExportName
min :: DummyExportName -> DummyExportName -> DummyExportName
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 =
  Error -> ExceptT Error IO a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Text -> Error
NoMatch (Text -> Path b File -> Text
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 Maybe Int
-> (Int -> (ByteString, ByteString))
-> Maybe (ByteString, ByteString)
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 -> 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 Builder -> Builder -> Builder
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 =
  (ByteString -> ByteString -> ByteString)
-> ByteString -> [ByteString] -> ByteString
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ByteString -> ByteString -> ByteString
forall {a}. (Semigroup a, IsString a) => a -> a -> a
joinLine ByteString
forall a. Monoid a => a
mempty
  where
    joinLine :: a -> a -> a
joinLine a
a a
b = a
b a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"\n"

joinLinesReverseBuilder :: [ByteString] -> Builder
joinLinesReverseBuilder :: [ByteString] -> Builder
joinLinesReverseBuilder =
  (ByteString -> Builder -> Builder)
-> Builder -> [ByteString] -> Builder
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ByteString -> Builder -> Builder
joinLine Builder
forall a. Monoid a => a
mempty
  where
    joinLine :: ByteString -> Builder -> Builder
joinLine ByteString
a Builder
b = Builder
b Builder -> Builder -> Builder
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 -> Builder -> Maybe Builder
forall a. a -> Maybe a
Just (KnownExtension -> Builder
forall b a. (Show a, IsString b) => a -> b
show KnownExtension
ext)
  DisableExtension KnownExtension
ext -> Builder -> Maybe Builder
forall a. a -> Maybe a
Just (Builder
"No" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> KnownExtension -> Builder
forall b a. (Show a, IsString b) => a -> b
show KnownExtension
ext)
  UnknownExtension String
_ -> Maybe Builder
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
  | [Builder] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null CabalConfig
conf.extensions = Maybe Builder
forall a. Maybe a
Nothing
  | Bool
otherwise = Builder -> Maybe Builder
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 =
  p Match (f Match) -> ByteString -> f ByteString
[regex|\bNoImplicitPrelude\b|]

commentRegex :: Regex
commentRegex :: Regex
commentRegex =
  p Match (f Match) -> ByteString -> f ByteString
[regex|^\s*--|]

moduleRegex :: Regex
moduleRegex :: Regex
moduleRegex =
  p Match (f Match) -> ByteString -> f ByteString
[regex|^\s*module\b\s+(\S+)|]

moduleEndRegex :: Regex
moduleEndRegex :: Regex
moduleEndRegex =
  p Match (f Match) -> ByteString -> f ByteString
[regex|\bwhere\b|]

importsEndRegex :: Regex
importsEndRegex :: Regex
importsEndRegex =
  p Match (f Match) -> ByteString -> f ByteString
[regex|^\S|]

importRegex :: Regex
importRegex :: Regex
importRegex =
  p Match (f Match) -> ByteString -> f ByteString
[regex|^import\b|]

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

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

isModule :: ByteString -> Maybe ByteString
isModule :: ByteString -> Maybe ByteString
isModule =
  Getting (First ByteString) ByteString ByteString
-> ByteString -> Maybe ByteString
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Match -> Const (First ByteString) Match)
-> ByteString -> Const (First ByteString) ByteString
Regex
moduleRegex ((Match -> Const (First ByteString) Match)
 -> ByteString -> Const (First ByteString) ByteString)
-> ((ByteString -> Const (First ByteString) ByteString)
    -> Match -> Const (First ByteString) Match)
-> Getting (First ByteString) ByteString ByteString
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 =
  Getting Any ByteString Match -> ByteString -> Bool
forall s a. Getting Any s a -> s -> Bool
has Getting Any ByteString Match
Regex
moduleEndRegex

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

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

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

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

data CustomPrelude =
  CustomPrelude Prelude PreludeAction
  |
  NoCustomPrelude
  deriving stock (Int -> CustomPrelude -> ShowS
[CustomPrelude] -> ShowS
CustomPrelude -> String
(Int -> CustomPrelude -> ShowS)
-> (CustomPrelude -> String)
-> ([CustomPrelude] -> ShowS)
-> Show CustomPrelude
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CustomPrelude -> ShowS
showsPrec :: Int -> CustomPrelude -> ShowS
$cshow :: CustomPrelude -> String
show :: CustomPrelude -> String
$cshowList :: [CustomPrelude] -> ShowS
showList :: [CustomPrelude] -> ShowS
Show, (forall x. CustomPrelude -> Rep CustomPrelude x)
-> (forall x. Rep CustomPrelude x -> CustomPrelude)
-> Generic CustomPrelude
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
$cfrom :: forall x. CustomPrelude -> Rep CustomPrelude x
from :: forall x. CustomPrelude -> Rep CustomPrelude x
$cto :: forall x. Rep CustomPrelude x -> CustomPrelude
to :: forall x. Rep CustomPrelude x -> CustomPrelude
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 =
  p Match (f Match) -> ByteString -> f ByteString
[regex|^import\s+(?:qualified\s+)?((?:"[^"]+"\s+)?)(Prelude\b)(?:$|[^.])|]

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

parenRegex :: Regex
parenRegex :: Regex
parenRegex =
  p Match (f Match) -> ByteString -> f ByteString
[regex|(\()|]

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

dummyExportPlaceholderRegex :: Regex
dummyExportPlaceholderRegex :: Regex
dummyExportPlaceholderRegex =
  p Match (f Match) -> ByteString -> f ByteString
[regex|HIX_DUMMY_EXPORT>|]

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

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

moduleExports ::
  ByteString ->
  [ByteString]
moduleExports :: ByteString -> [ByteString]
moduleExports ByteString
l =
  ByteString
l ByteString
-> Getting (Endo [ByteString]) ByteString ByteString
-> [ByteString]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Match -> Const (Endo [ByteString]) Match)
-> ByteString -> Const (Endo [ByteString]) ByteString
Regex
moduleExportsRegex ((Match -> Const (Endo [ByteString]) Match)
 -> ByteString -> Const (Endo [ByteString]) ByteString)
-> ((ByteString -> Const (Endo [ByteString]) ByteString)
    -> Match -> Const (Endo [ByteString]) Match)
-> Getting (Endo [ByteString]) ByteString ByteString
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
(Int -> Header -> ShowS)
-> (Header -> String) -> ([Header] -> ShowS) -> Show Header
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Header -> ShowS
showsPrec :: Int -> Header -> ShowS
$cshow :: Header -> String
show :: Header -> String
$cshowList :: [Header] -> ShowS
showList :: [Header] -> ShowS
Show, (forall x. Header -> Rep Header x)
-> (forall x. Rep Header x -> Header) -> Generic Header
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
$cfrom :: forall x. Header -> Rep Header x
from :: forall x. Header -> Rep Header x
$cto :: forall x. Rep Header x -> Header
to :: forall x. Rep Header x -> Header
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
(Int -> ScanState -> ShowS)
-> (ScanState -> String)
-> ([ScanState] -> ShowS)
-> Show ScanState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScanState -> ShowS
showsPrec :: Int -> ScanState -> ShowS
$cshow :: ScanState -> String
show :: ScanState -> String
$cshowList :: [ScanState] -> ShowS
showList :: [ScanState] -> ShowS
Show, (forall x. ScanState -> Rep ScanState x)
-> (forall x. Rep ScanState x -> ScanState) -> Generic ScanState
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
$cfrom :: forall x. ScanState -> Rep ScanState x
from :: forall x. ScanState -> Rep ScanState x
$cto :: forall x. Rep ScanState x -> ScanState
to :: forall x. Rep ScanState x -> ScanState
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 = [ByteString]
forall a. Monoid a => a
mempty,
    $sel:importLines:ScanState :: [ByteString]
importLines = [ByteString]
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 = Maybe ByteString
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 Builder
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
$sel:moduleLines:ScanState :: ScanState -> [ByteString]
$sel:importLines:ScanState :: ScanState -> [ByteString]
$sel:moduleLength:ScanState :: ScanState -> Int
$sel:importsLength:ScanState :: ScanState -> Int
$sel:moduleName:ScanState :: ScanState -> Maybe ByteString
$sel:exportsSelf:ScanState :: ScanState -> Bool
moduleLines :: [ByteString]
importLines :: [ByteString]
moduleLength :: Int
importsLength :: Int
moduleName :: Maybe ByteString
exportsSelf :: Bool
..} 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
$sel:moduleLines:ScanState :: [ByteString]
$sel:importLines:ScanState :: [ByteString]
$sel:moduleLength:ScanState :: Int
$sel:importsLength:ScanState :: Int
$sel:moduleName:ScanState :: Maybe ByteString
$sel:exportsSelf:ScanState :: Bool
moduleLines :: [ByteString]
importLines :: [ByteString]
moduleLength :: Int
importsLength :: Int
moduleName :: Maybe ByteString
exportsSelf :: Bool
..} 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 ScanState -> (ScanState -> ScanState) -> ScanState
forall a b. a -> (a -> b) -> b
& ASetter ScanState ScanState (Maybe ByteString) (Maybe ByteString)
#moduleName ASetter ScanState ScanState (Maybe ByteString) (Maybe ByteString)
-> Maybe ByteString -> ScanState -> ScanState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString -> Maybe ByteString
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 | Getting Any ByteString Match -> ByteString -> Bool
forall s a. Getting Any s a -> s -> Bool
has Getting Any ByteString Match
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
      , ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ByteString
name [ByteString]
exs =
        ScanState -> ByteString -> ByteString -> Header
processLine (ScanState
s ScanState -> (ScanState -> ScanState) -> ScanState
forall a b. a -> (a -> b) -> b
& ASetter ScanState ScanState Bool Bool
#exportsSelf ASetter ScanState ScanState Bool Bool
-> Bool -> ScanState -> ScanState
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
$sel:moduleLines:ScanState :: ScanState -> [ByteString]
$sel:importLines:ScanState :: ScanState -> [ByteString]
$sel:moduleLength:ScanState :: ScanState -> Int
$sel:importsLength:ScanState :: ScanState -> Int
$sel:prelude:ScanState :: ScanState -> CustomPrelude
$sel:moduleName:ScanState :: ScanState -> Maybe ByteString
$sel:exportsSelf:ScanState :: ScanState -> Bool
moduleLines :: [ByteString]
importLines :: [ByteString]
moduleLength :: Int
importsLength :: Int
prelude :: CustomPrelude
moduleName :: Maybe ByteString
exportsSelf :: Bool
..} 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
$sel:moduleLines:ScanState :: [ByteString]
$sel:importLines:ScanState :: [ByteString]
$sel:moduleLength:ScanState :: Int
$sel:importsLength:ScanState :: Int
$sel:prelude:ScanState :: CustomPrelude
$sel:moduleName:ScanState :: Maybe ByteString
$sel:exportsSelf:ScanState :: Bool
moduleLines :: [ByteString]
importLines :: [ByteString]
moduleLength :: Int
importsLength :: Int
prelude :: CustomPrelude
moduleName :: Maybe ByteString
exportsSelf :: Bool
..} 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
$sel:moduleLines:ScanState :: ScanState -> [ByteString]
$sel:importLines:ScanState :: ScanState -> [ByteString]
$sel:moduleLength:ScanState :: ScanState -> Int
$sel:importsLength:ScanState :: ScanState -> Int
$sel:moduleName:ScanState :: ScanState -> Maybe ByteString
$sel:exportsSelf:ScanState :: ScanState -> Bool
moduleLines :: [ByteString]
importLines :: [ByteString]
moduleLength :: Int
importsLength :: Int
moduleName :: Maybe ByteString
exportsSelf :: Bool
..} 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
$sel:moduleLines:ScanState :: [ByteString]
$sel:importLines:ScanState :: [ByteString]
$sel:moduleLength:ScanState :: Int
$sel:importsLength:ScanState :: Int
$sel:moduleName:ScanState :: Maybe ByteString
$sel:exportsSelf:ScanState :: Bool
moduleLines :: [ByteString]
importLines :: [ByteString]
moduleLength :: Int
importsLength :: Int
moduleName :: Maybe ByteString
exportsSelf :: Bool
..} 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 Builder -> Builder -> Builder
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
$sel:phase:ScanState :: Phase
phase :: Phase
phase}

    pushCurrent :: ScanState -> ByteString -> ByteString -> Header
pushCurrent s :: ScanState
s@ScanState {Phase
$sel:phase:ScanState :: ScanState -> Phase
phase :: 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
$sel:phase:ScanState :: ScanState -> Phase
$sel:moduleLines:ScanState :: ScanState -> [ByteString]
$sel:importLines:ScanState :: ScanState -> [ByteString]
$sel:moduleLength:ScanState :: ScanState -> Int
$sel:importsLength:ScanState :: ScanState -> Int
$sel:prelude:ScanState :: ScanState -> CustomPrelude
$sel:moduleName:ScanState :: ScanState -> Maybe ByteString
$sel:exportsSelf:ScanState :: ScanState -> Bool
phase :: Phase
moduleLines :: [ByteString]
importLines :: [ByteString]
moduleLength :: Int
importsLength :: Int
prelude :: CustomPrelude
moduleName :: Maybe ByteString
exportsSelf :: Bool
..} ByteString
l =
      ScanState -> ByteString -> Header
tryProcessLine ScanState {
        $sel:moduleLines:ScanState :: [ByteString]
moduleLines = ByteString
l ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
moduleLines,
        $sel:moduleLength:ScanState :: Int
moduleLength = Int
moduleLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1,
        Bool
Int
[ByteString]
Maybe ByteString
CustomPrelude
Phase
$sel:phase:ScanState :: Phase
$sel:importLines:ScanState :: [ByteString]
$sel:importsLength:ScanState :: Int
$sel:prelude:ScanState :: CustomPrelude
$sel:moduleName:ScanState :: Maybe ByteString
$sel:exportsSelf:ScanState :: Bool
phase :: Phase
importLines :: [ByteString]
importsLength :: Int
prelude :: CustomPrelude
moduleName :: Maybe ByteString
exportsSelf :: Bool
..
      }

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

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

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

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
Item [Builder]
"PackageImports", Builder
Item [Builder]
"NoImplicitPrelude"])
  CustomPrelude
_ ->
    Builder
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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
lineNo
  CustomPrelude
_ -> Builder
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|] Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
lineNo
dummyDecl CustomPrelude
_ Builder
_ DummyExportName
_ =
  Builder
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) =
  Indexed Int Match (Identity Match)
-> ByteString -> Identity ByteString
Regex
dummyExportPlaceholderRegex (Indexed Int Match (Identity Match)
 -> ByteString -> Identity ByteString)
-> ((ByteString -> Identity ByteString)
    -> Indexed Int Match (Identity Match))
-> (ByteString -> Identity ByteString)
-> ByteString
-> Identity ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Optical' (->) (Indexed Int) Identity Match Match
forall i (p :: * -> * -> *) (f :: * -> *) a.
(Indexable i p, Eq i, Applicative f) =>
i -> Optical' p (Indexed i) f a a
index Int
0 Optical' (->) (Indexed Int) Identity Match Match
-> ((ByteString -> Identity ByteString) -> Match -> Identity Match)
-> (ByteString -> Identity ByteString)
-> Indexed Int Match (Identity Match)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Identity ByteString) -> Match -> Identity Match
IndexedTraversal' [ByteString] Match ByteString
match ((ByteString -> Identity ByteString)
 -> ByteString -> Identity ByteString)
-> ByteString -> ByteString -> ByteString
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [exon|#{n},|]
replaceDummy CustomPrelude
_ Bool
_ DummyExportName
_ =
  Indexed Int Match (Identity Match)
-> ByteString -> Identity ByteString
Regex
dummyExportPlaceholderRegex (Indexed Int Match (Identity Match)
 -> ByteString -> Identity ByteString)
-> ((ByteString -> Identity ByteString)
    -> Indexed Int Match (Identity Match))
-> (ByteString -> Identity ByteString)
-> ByteString
-> Identity ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Optical' (->) (Indexed Int) Identity Match Match
forall i (p :: * -> * -> *) (f :: * -> *) a.
(Indexable i p, Eq i, Applicative f) =>
i -> Optical' p (Indexed i) f a a
index Int
0 Optical' (->) (Indexed Int) Identity Match Match
-> ((ByteString -> Identity ByteString) -> Match -> Identity Match)
-> (ByteString -> Identity ByteString)
-> Indexed Int Match (Identity Match)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Identity ByteString) -> Match -> Identity Match
IndexedTraversal' [ByteString] Match ByteString
match ((ByteString -> Identity ByteString)
 -> ByteString -> Identity ByteString)
-> ByteString -> ByteString -> ByteString
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
$sel:moduleLines:Header :: Header -> [ByteString]
$sel:importLines:Header :: Header -> [ByteString]
$sel:rest:Header :: Header -> Builder
$sel:moduleEndLine:Header :: Header -> Int
$sel:importsEndLine:Header :: Header -> Int
$sel:prelude:Header :: Header -> CustomPrelude
$sel:exportsSelf:Header :: Header -> Bool
moduleLines :: [ByteString]
importLines :: [ByteString]
rest :: Builder
moduleEndLine :: Int
importsEndLine :: Int
prelude :: CustomPrelude
exportsSelf :: Bool
..} Maybe Builder
exts Maybe Builder
options DummyExportName
dummyExportName =
  (Builder -> Builder) -> Maybe Builder -> Builder
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Builder -> Builder
optionsPragma Maybe Builder
options Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  (Builder -> Builder) -> Maybe Builder -> Builder
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Builder -> Builder
lineB Maybe Builder
exts Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  CustomPrelude -> Builder
preludeExtensions CustomPrelude
prelude Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Int -> Builder
linePragma Int
1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  ByteString -> Builder
byteString (CustomPrelude
-> Bool -> DummyExportName -> ByteString -> ByteString
replaceDummy CustomPrelude
prelude Bool
exportsSelf DummyExportName
dummyExportName ByteString
moduleString) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Builder -> CustomPrelude -> Builder
explicitPreludeImport (Int -> Builder
linePragma Int
moduleEndLine) CustomPrelude
prelude Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Builder
importsString Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  CustomPrelude -> Builder -> DummyExportName -> Builder
dummyDecl CustomPrelude
prelude (Int -> Builder
linePragma Int
importsEndLine) DummyExportName
dummyExportName Builder -> Builder -> Builder
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 = Builder -> NonEmpty Builder -> Builder
forall a (t :: * -> *).
(Exon a, Monoid a, Foldable t) =>
a -> t a -> a
Exon.intercalate Builder
" " (NonEmpty Builder -> Builder)
-> Maybe (NonEmpty Builder) -> Maybe Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Builder] -> Maybe (NonEmpty Builder)
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 <- ExceptT Error IO ByteString
-> ReaderT Env (ExceptT Error IO) ByteString
forall (m :: * -> *) a. Monad m => m a -> ReaderT Env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ByteString -> ExceptT Error IO ByteString
forall a. IO a -> ExceptT Error IO a
tryIO (String -> IO ByteString
ByteString.readFile (Path Abs File -> String
forall b t. Path b t -> String
toFilePath PreprocOptions
opt.inFile)))
  Int
dummyNumber :: Int <- (Int, Int) -> ReaderT Env (ExceptT Error IO) 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
  ExceptT Error IO () -> M ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT Env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ExceptT Error IO ()
forall a. IO a -> ExceptT Error IO a
tryIO (String -> Builder -> IO ()
ByteStringBuilder.writeFile (Path Abs File -> String
forall b t. Path b t -> String
toFilePath PreprocOptions
opt.outFile) Builder
result))

fromConfig ::
  Maybe (Path Abs Dir) ->
  Path Abs File ->
  Either PreprocConfig JsonConfig ->
  M CabalConfig
fromConfig :: Maybe (Path Abs Dir)
-> Path Abs File
-> Either PreprocConfig JsonConfig
-> M CabalConfig
fromConfig Maybe (Path Abs Dir)
cliRoot Path Abs File
source Either PreprocConfig JsonConfig
pconf = do
  PreprocConfig
conf <- (PreprocConfig -> ReaderT Env (ExceptT Error IO) PreprocConfig)
-> (JsonConfig -> ReaderT Env (ExceptT Error IO) PreprocConfig)
-> Either PreprocConfig JsonConfig
-> ReaderT Env (ExceptT Error IO) PreprocConfig
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PreprocConfig -> ReaderT Env (ExceptT Error IO) PreprocConfig
forall a. a -> ReaderT Env (ExceptT Error IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JsonConfig -> ReaderT Env (ExceptT Error IO) PreprocConfig
forall a. FromJSON a => JsonConfig -> M a
jsonConfig Either PreprocConfig JsonConfig
pconf
  Target
target <- Maybe (Path Abs Dir)
-> Maybe PackageName
-> Map PackageName PackageConfig
-> TargetSpec
-> M Target
targetComponentOrError Maybe (Path Abs Dir)
cliRoot Maybe PackageName
forall a. Maybe a
Nothing PreprocConfig
conf.packages (Path Abs File -> TargetSpec
TargetForFile Path Abs File
source)
  pure CabalConfig {
    $sel:extensions:CabalConfig :: [Builder]
extensions = String -> Builder
stringUtf8 (String -> Builder) -> [String] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Target
target.component.language String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Target
target.component.extensions,
    $sel:ghcOptions:CabalConfig :: [Builder]
ghcOptions = String -> Builder
stringUtf8 (String -> Builder) -> [String] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Target
target.component.ghcOptions,
    $sel:prelude:CabalConfig :: Maybe Prelude
prelude = PreprocConfig -> PreludeConfig -> Prelude
fromPreludeConfig PreprocConfig
conf (PreludeConfig -> Prelude) -> Maybe PreludeConfig -> Maybe Prelude
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 = Maybe Builder -> [Builder]
forall a. Maybe a -> [a]
maybeToList (Language -> Maybe Builder
dlExtension (Language -> Maybe Builder) -> Maybe Language -> Maybe Builder
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BuildInfo
info.defaultLanguage) [Builder] -> [Builder] -> [Builder]
forall a. Semigroup a => a -> a -> a
<> (Extension -> Maybe Builder) -> [Extension] -> [Builder]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Extension -> Maybe Builder
extension BuildInfo
info.defaultExtensions,
    $sel:ghcOptions:CabalConfig :: [Builder]
ghcOptions = String -> Builder
stringUtf8 (String -> Builder) -> [String] -> [Builder]
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
_ -> Maybe Builder
forall a. Maybe a
Nothing
      Language
lang -> Builder -> Maybe Builder
forall a. a -> Maybe a
Just (String -> Builder
stringUtf8 (Language -> String
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 (BuildInfo -> CabalConfig)
-> ReaderT Env (ExceptT Error IO) BuildInfo -> M CabalConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT Error IO BuildInfo
-> ReaderT Env (ExceptT Error IO) BuildInfo
forall (m :: * -> *) a. Monad m => m a -> ReaderT Env m a
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 <- M CabalConfig
-> (Either PreprocConfig JsonConfig -> M CabalConfig)
-> Maybe (Either PreprocConfig JsonConfig)
-> M CabalConfig
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Path Abs File -> M CabalConfig
fromCabalFile PreprocOptions
opt.source) (Maybe (Path Abs Dir)
-> Path Abs File
-> Either PreprocConfig JsonConfig
-> M CabalConfig
fromConfig PreprocOptions
opt.root PreprocOptions
opt.source) PreprocOptions
opt.config
  PreprocOptions -> CabalConfig -> M ()
preprocessWith PreprocOptions
opt CabalConfig
conf