module Hix.Bootstrap where

import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Reader (ask)
import Data.List.NonEmpty ((<|))
import qualified Data.Text as Text
import Distribution.Compiler (PerCompilerFlavor (PerCompilerFlavor))
import qualified Distribution.PackageDescription as Cabal
import Distribution.PackageDescription (
  BuildInfo,
  GenericPackageDescription,
  PackageDescription,
  UnqualComponentName,
  buildType,
  licenseFiles,
  unPackageName,
  unUnqualComponentName,
  )
import Distribution.Pretty (Pretty, pretty)
import Distribution.Simple (Dependency (Dependency), depVerRange)
import Distribution.Types.PackageDescription (license)
import Distribution.Utils.ShortText (ShortText, fromShortText)
import qualified Distribution.Verbosity as Cabal
import Exon (exon)
import Path (Abs, Dir, File, Path, Rel, parent, parseRelFile, relfile, toFilePath, (</>))
import System.FilePattern.Directory (getDirectoryFilesIgnore)

import Hix.Compat (readGenericPackageDescription)
import qualified Hix.Data.BootstrapProjectConfig
import Hix.Data.BootstrapProjectConfig (BootstrapProjectConfig)
import qualified Hix.Data.ComponentConfig
import Hix.Data.ComponentConfig (PackageName (PackageName))
import Hix.Data.Error (pathText, tryIO)
import qualified Hix.Data.NewProjectConfig
import qualified Hix.Data.ProjectFile
import Hix.Data.ProjectFile (ProjectFile (ProjectFile), createFile)
import qualified Hix.Monad
import Hix.Monad (Env (Env), M, noteBootstrap)
import qualified Hix.Prelude
import Hix.Prelude (Prelude, findPrelude)

data ExprAttr =
  ExprAttr {
    ExprAttr -> Text
name :: Text,
    ExprAttr -> Expr
value :: Expr
  }
  |
  ExprAttrNil
  deriving stock (ExprAttr -> ExprAttr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExprAttr -> ExprAttr -> Bool
$c/= :: ExprAttr -> ExprAttr -> Bool
== :: ExprAttr -> ExprAttr -> Bool
$c== :: ExprAttr -> ExprAttr -> Bool
Eq, Int -> ExprAttr -> ShowS
[ExprAttr] -> ShowS
ExprAttr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExprAttr] -> ShowS
$cshowList :: [ExprAttr] -> ShowS
show :: ExprAttr -> String
$cshow :: ExprAttr -> String
showsPrec :: Int -> ExprAttr -> ShowS
$cshowsPrec :: Int -> ExprAttr -> ShowS
Show, forall x. Rep ExprAttr x -> ExprAttr
forall x. ExprAttr -> Rep ExprAttr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExprAttr x -> ExprAttr
$cfrom :: forall x. ExprAttr -> Rep ExprAttr x
Generic)

data Expr =
  ExprString Text
  |
  ExprLit Text
  |
  ExprList [Expr]
  |
  ExprAttrs [ExprAttr]
  |
  ExprPrefix Text Expr
  deriving stock (Expr -> Expr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expr -> Expr -> Bool
$c/= :: Expr -> Expr -> Bool
== :: Expr -> Expr -> Bool
$c== :: Expr -> Expr -> Bool
Eq, Int -> Expr -> ShowS
[Expr] -> ShowS
Expr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expr] -> ShowS
$cshowList :: [Expr] -> ShowS
show :: Expr -> String
$cshow :: Expr -> String
showsPrec :: Int -> Expr -> ShowS
$cshowsPrec :: Int -> Expr -> ShowS
Show, forall x. Rep Expr x -> Expr
forall x. Expr -> Rep Expr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Expr x -> Expr
$cfrom :: forall x. Expr -> Rep Expr x
Generic)

exprStrings :: [Text] -> Expr
exprStrings :: [Text] -> Expr
exprStrings =
  [Expr] -> Expr
ExprList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Expr
ExprString

data CabalInfo =
  CabalInfo {
    CabalInfo -> Path Rel Dir
path :: Path Rel Dir,
    CabalInfo -> GenericPackageDescription
info :: GenericPackageDescription
  }
  deriving stock (CabalInfo -> CabalInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CabalInfo -> CabalInfo -> Bool
$c/= :: CabalInfo -> CabalInfo -> Bool
== :: CabalInfo -> CabalInfo -> Bool
$c== :: CabalInfo -> CabalInfo -> Bool
Eq, Int -> CabalInfo -> ShowS
[CabalInfo] -> ShowS
CabalInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CabalInfo] -> ShowS
$cshowList :: [CabalInfo] -> ShowS
show :: CabalInfo -> String
$cshow :: CabalInfo -> String
showsPrec :: Int -> CabalInfo -> ShowS
$cshowsPrec :: Int -> CabalInfo -> ShowS
Show, forall x. Rep CabalInfo x -> CabalInfo
forall x. CabalInfo -> Rep CabalInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CabalInfo x -> CabalInfo
$cfrom :: forall x. CabalInfo -> Rep CabalInfo x
Generic)

data ComponentType =
  Library
  |
  Executable Text
  |
  Benchmark Text
  |
  Test Text
  deriving stock (ComponentType -> ComponentType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentType -> ComponentType -> Bool
$c/= :: ComponentType -> ComponentType -> Bool
== :: ComponentType -> ComponentType -> Bool
$c== :: ComponentType -> ComponentType -> Bool
Eq, Int -> ComponentType -> ShowS
[ComponentType] -> ShowS
ComponentType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentType] -> ShowS
$cshowList :: [ComponentType] -> ShowS
show :: ComponentType -> String
$cshow :: ComponentType -> String
showsPrec :: Int -> ComponentType -> ShowS
$cshowsPrec :: Int -> ComponentType -> ShowS
Show, forall x. Rep ComponentType x -> ComponentType
forall x. ComponentType -> Rep ComponentType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ComponentType x -> ComponentType
$cfrom :: forall x. ComponentType -> Rep ComponentType x
Generic)

data PreludeWithVersion =
  PreludeWithVersion {
    PreludeWithVersion -> Prelude
prelude :: Prelude,
    PreludeWithVersion -> Maybe Dependency
dep :: Maybe Dependency
  }
  deriving stock (PreludeWithVersion -> PreludeWithVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PreludeWithVersion -> PreludeWithVersion -> Bool
$c/= :: PreludeWithVersion -> PreludeWithVersion -> Bool
== :: PreludeWithVersion -> PreludeWithVersion -> Bool
$c== :: PreludeWithVersion -> PreludeWithVersion -> Bool
Eq, Int -> PreludeWithVersion -> ShowS
[PreludeWithVersion] -> ShowS
PreludeWithVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PreludeWithVersion] -> ShowS
$cshowList :: [PreludeWithVersion] -> ShowS
show :: PreludeWithVersion -> String
$cshow :: PreludeWithVersion -> String
showsPrec :: Int -> PreludeWithVersion -> ShowS
$cshowsPrec :: Int -> PreludeWithVersion -> ShowS
Show, forall x. Rep PreludeWithVersion x -> PreludeWithVersion
forall x. PreludeWithVersion -> Rep PreludeWithVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PreludeWithVersion x -> PreludeWithVersion
$cfrom :: forall x. PreludeWithVersion -> Rep PreludeWithVersion x
Generic)

data HixComponent =
  HixComponent {
    HixComponent -> ComponentType
special :: ComponentType,
    HixComponent -> [ExprAttr]
known :: [ExprAttr],
    HixComponent -> Maybe PreludeWithVersion
prelude :: Maybe PreludeWithVersion
  }
  deriving stock (HixComponent -> HixComponent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HixComponent -> HixComponent -> Bool
$c/= :: HixComponent -> HixComponent -> Bool
== :: HixComponent -> HixComponent -> Bool
$c== :: HixComponent -> HixComponent -> Bool
Eq, Int -> HixComponent -> ShowS
[HixComponent] -> ShowS
HixComponent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HixComponent] -> ShowS
$cshowList :: [HixComponent] -> ShowS
show :: HixComponent -> String
$cshow :: HixComponent -> String
showsPrec :: Int -> HixComponent -> ShowS
$cshowsPrec :: Int -> HixComponent -> ShowS
Show, forall x. Rep HixComponent x -> HixComponent
forall x. HixComponent -> Rep HixComponent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HixComponent x -> HixComponent
$cfrom :: forall x. HixComponent -> Rep HixComponent x
Generic)

data HixPackage =
  HixPackage {
    HixPackage -> PackageName
name :: PackageName,
    HixPackage -> Path Rel Dir
src :: Path Rel Dir,
    HixPackage -> [ExprAttr]
known :: [ExprAttr],
    HixPackage -> [ExprAttr]
meta :: [ExprAttr],
    HixPackage -> ExprAttr
description :: ExprAttr,
    HixPackage -> [HixComponent]
components :: [HixComponent]
  }
  deriving stock (HixPackage -> HixPackage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HixPackage -> HixPackage -> Bool
$c/= :: HixPackage -> HixPackage -> Bool
== :: HixPackage -> HixPackage -> Bool
$c== :: HixPackage -> HixPackage -> Bool
Eq, Int -> HixPackage -> ShowS
[HixPackage] -> ShowS
HixPackage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HixPackage] -> ShowS
$cshowList :: [HixPackage] -> ShowS
show :: HixPackage -> String
$cshow :: HixPackage -> String
showsPrec :: Int -> HixPackage -> ShowS
$cshowsPrec :: Int -> HixPackage -> ShowS
Show, forall x. Rep HixPackage x -> HixPackage
forall x. HixPackage -> Rep HixPackage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HixPackage x -> HixPackage
$cfrom :: forall x. HixPackage -> Rep HixPackage x
Generic)

indent ::
  Functor t =>
  Int ->
  t Text ->
  t Text
indent :: forall (t :: * -> *). Functor t => Int -> t Text -> t Text
indent Int
n =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text
Text.replicate Int
n Text
" " <>)

withSemicolon :: NonEmpty Text -> NonEmpty Text
withSemicolon :: NonEmpty Text -> NonEmpty Text
withSemicolon = \case
  Text
e :| [] ->
    [Text
e forall a. Semigroup a => a -> a -> a
<> Text
";"]
  Text
h :| Text
h1 : [Text]
t -> Text
h forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty Text -> NonEmpty Text
withSemicolon (Text
h1 forall a. a -> [a] -> NonEmpty a
:| [Text]
t)

renderAttrs :: Int -> [ExprAttr] -> [Text]
renderAttrs :: Int -> [ExprAttr] -> [Text]
renderAttrs Int
ind [ExprAttr]
attrs =
  [ExprAttr]
attrs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    ExprAttr Text
k Expr
v ->
      case Int -> Expr -> NonEmpty Text
renderExpr Int
ind Expr
v of
        Text
e :| [] -> [[exon|#{k} = #{e};|]]
        Text
h :| (Text
h1 : [Text]
t) -> [exon|#{k} = #{h}|] forall a. a -> [a] -> [a]
: forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Text -> NonEmpty Text
withSemicolon (Text
h1 forall a. a -> [a] -> NonEmpty a
:| [Text]
t))
    ExprAttr
ExprAttrNil ->
      []

renderExpr :: Int -> Expr -> NonEmpty Text
renderExpr :: Int -> Expr -> NonEmpty Text
renderExpr Int
ind = \case
  ExprString Text
s -> forall (t :: * -> *). Functor t => Int -> t Text -> t Text
indent Int
ind [[exon|"#{s}"|]]
  ExprLit Text
e -> [Text
e]
  ExprList [Expr]
l -> Text
"[" forall a. a -> [a] -> NonEmpty a
:| (forall (t :: * -> *). Functor t => Int -> t Text -> t Text
indent (Int
ind forall a. Num a => a -> a -> a
+ Int
2) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> NonEmpty Text
renderExpr Int
ind forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Expr]
l)) forall a. [a] -> [a] -> [a]
++ [Text
"]"]
  ExprAttrs [ExprAttr]
a -> case Int -> [ExprAttr] -> [Text]
renderAttrs Int
ind [ExprAttr]
a of
    [] -> [Text
"{};"]
    [Text]
as -> Text
"{" forall a. a -> [a] -> NonEmpty a
:| forall (t :: * -> *). Functor t => Int -> t Text -> t Text
indent (Int
ind forall a. Num a => a -> a -> a
+ Int
2) [Text]
as forall a. [a] -> [a] -> [a]
++ [Text
"}"]
  ExprPrefix Text
p (Int -> Expr -> NonEmpty Text
renderExpr Int
ind -> Text
h :| [Text]
t) ->
    [exon|#{p} #{h}|] forall a. a -> [a] -> NonEmpty a
:| [Text]
t

renderRootExpr :: Expr -> Text
renderRootExpr :: Expr -> Text
renderRootExpr =
  [Text] -> Text
Text.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> NonEmpty Text
renderExpr Int
0

readCabal ::
  Path Abs Dir ->
  Path Rel File ->
  M CabalInfo
readCabal :: Path Abs Dir -> Path Rel File -> M CabalInfo
readCabal Path Abs Dir
root Path Rel File
path = do
  GenericPackageDescription
info <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Verbosity -> String -> IO GenericPackageDescription
readGenericPackageDescription Verbosity
Cabal.verbose (forall b t. Path b t -> String
toFilePath (Path Abs Dir
root forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
path)))
  pure CabalInfo {$sel:path:CabalInfo :: Path Rel Dir
path = Path Rel Dir
dir, GenericPackageDescription
info :: GenericPackageDescription
$sel:info:CabalInfo :: GenericPackageDescription
info}
  where
    dir :: Path Rel Dir
dir = forall b t. Path b t -> Path b Dir
parent Path Rel File
path

class RenderCabalOption a where
  renderCabalOption :: a -> Text

instance {-# overlappable #-} Pretty a => RenderCabalOption a where
  renderCabalOption :: a -> Text
renderCabalOption = forall b a. (Show a, IsString b) => a -> b
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
pretty

instance RenderCabalOption ShortText where
  renderCabalOption :: ShortText -> Text
renderCabalOption = forall a. ToText a => a -> Text
toText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> String
fromShortText

instance RenderCabalOption String where
  renderCabalOption :: String -> Text
renderCabalOption = forall a. ToText a => a -> Text
toText

checkEmpty ::
  Text ->
  Expr ->
  ExprAttr
checkEmpty :: Text -> Expr -> ExprAttr
checkEmpty Text
key = \case
  ExprString Text
value | Text -> Bool
Text.null Text
value ->
    ExprAttr
ExprAttrNil
  ExprList [Expr]
value | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Expr]
value ->
    ExprAttr
ExprAttrNil
  Expr
value ->
    Text -> Expr -> ExprAttr
ExprAttr Text
key Expr
value

singleOpt ::
  RenderCabalOption a =>
  Text ->
  (e -> Maybe a) ->
  e ->
  ExprAttr
singleOpt :: forall a e.
RenderCabalOption a =>
Text -> (e -> Maybe a) -> e -> ExprAttr
singleOpt Text
key e -> Maybe a
get e
entity =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe ExprAttr
ExprAttrNil (Text -> Expr -> ExprAttr
checkEmpty Text
key forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Expr
ExprString) (forall a. RenderCabalOption a => a -> Text
renderCabalOption forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e -> Maybe a
get e
entity)

single ::
  RenderCabalOption a =>
  Text ->
  (e -> a) ->
  e ->
  ExprAttr
single :: forall a e.
RenderCabalOption a =>
Text -> (e -> a) -> e -> ExprAttr
single Text
key e -> a
get =
  forall a e.
RenderCabalOption a =>
Text -> (e -> Maybe a) -> e -> ExprAttr
singleOpt Text
key (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> a
get)

multiOpt ::
  RenderCabalOption a =>
  Text ->
  (e -> Maybe [a]) ->
  e ->
  ExprAttr
multiOpt :: forall a e.
RenderCabalOption a =>
Text -> (e -> Maybe [a]) -> e -> ExprAttr
multiOpt Text
key e -> Maybe [a]
get e
entity =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe ExprAttr
ExprAttrNil (Text -> Expr -> ExprAttr
checkEmpty Text
key forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Expr
exprStrings) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. RenderCabalOption a => a -> Text
renderCabalOption forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e -> Maybe [a]
get e
entity)

multi ::
  RenderCabalOption a =>
  Text ->
  (e -> [a]) ->
  e ->
  ExprAttr
multi :: forall a e.
RenderCabalOption a =>
Text -> (e -> [a]) -> e -> ExprAttr
multi Text
key e -> [a]
get =
  forall a e.
RenderCabalOption a =>
Text -> (e -> Maybe [a]) -> e -> ExprAttr
multiOpt Text
key (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> [a]
get)

multiOrSingle ::
  ∀ a e .
  RenderCabalOption a =>
  Text ->
  (e -> [a]) ->
  e ->
  ExprAttr
multiOrSingle :: forall a e.
RenderCabalOption a =>
Text -> (e -> [a]) -> e -> ExprAttr
multiOrSingle Text
key e -> [a]
get e
entity =
  [Text] -> ExprAttr
check (forall a. RenderCabalOption a => a -> Text
renderCabalOption forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e -> [a]
get e
entity)
  where
    check :: [Text] -> ExprAttr
    check :: [Text] -> ExprAttr
check [] = ExprAttr
ExprAttrNil
    check [Item [Text]
sing] = Text -> Expr -> ExprAttr
ExprAttr Text
key (Text -> Expr
ExprString Item [Text]
sing)
    check [Text]
values = Text -> Expr -> ExprAttr
ExprAttr Text
key ([Text] -> Expr
exprStrings [Text]
values)

mkAttrs :: [e -> ExprAttr] -> e -> [ExprAttr]
mkAttrs :: forall e. [e -> ExprAttr] -> e -> [ExprAttr]
mkAttrs [e -> ExprAttr]
a e
e =
  (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ e
e) [e -> ExprAttr]
a)

-- TODO extract version and put it in a file
knownPackageKeys :: PackageDescription -> [ExprAttr]
knownPackageKeys :: PackageDescription -> [ExprAttr]
knownPackageKeys =
  forall e. [e -> ExprAttr] -> e -> [ExprAttr]
mkAttrs [
    forall a e.
RenderCabalOption a =>
Text -> (e -> a) -> e -> ExprAttr
single Text
"author" (.author),
    forall a e.
RenderCabalOption a =>
Text -> (e -> a) -> e -> ExprAttr
single Text
"build-type" PackageDescription -> BuildType
buildType,
    forall a e.
RenderCabalOption a =>
Text -> (e -> a) -> e -> ExprAttr
single Text
"copyright" (.copyright),
    forall a e.
RenderCabalOption a =>
Text -> (e -> a) -> e -> ExprAttr
single Text
"license" PackageDescription -> License
license,
    forall a e.
RenderCabalOption a =>
Text -> (e -> Maybe a) -> e -> ExprAttr
singleOpt Text
"license-file" (forall a. [a] -> Maybe a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [SymbolicPath PackageDir LicenseFile]
licenseFiles)
  ]

metaPackageKeys :: PackageDescription -> [ExprAttr]
metaPackageKeys :: PackageDescription -> [ExprAttr]
metaPackageKeys =
  forall e. [e -> ExprAttr] -> e -> [ExprAttr]
mkAttrs [
    forall a e.
RenderCabalOption a =>
Text -> (e -> a) -> e -> ExprAttr
single Text
"maintainer" (.maintainer),
    forall a e.
RenderCabalOption a =>
Text -> (e -> a) -> e -> ExprAttr
single Text
"homepage" (.homepage),
    forall a e.
RenderCabalOption a =>
Text -> (e -> a) -> e -> ExprAttr
single Text
"synopsis" (.synopsis)
  ]

ghcFlavour :: PerCompilerFlavor a -> a
ghcFlavour :: forall a. PerCompilerFlavor a -> a
ghcFlavour (PerCompilerFlavor a
a a
_) = a
a

notDefaultGhcOption :: String -> Bool
notDefaultGhcOption :: String -> Bool
notDefaultGhcOption = \case
  String
"-threaded" -> Bool
False
  String
"-rtsopts" -> Bool
False
  String
"-with-rtsopts=-N" -> Bool
False
  String
_ -> Bool
True

knownComponentKeys :: Maybe Prelude -> BuildInfo -> (Maybe PreludeWithVersion, [ExprAttr])
knownComponentKeys :: Maybe Prelude
-> BuildInfo -> (Maybe PreludeWithVersion, [ExprAttr])
knownComponentKeys Maybe Prelude
prelude BuildInfo
info =
  (Maybe PreludeWithVersion
preludeWithVersion, [ExprAttr]
vals)
  where
    vals :: [ExprAttr]
vals =
      forall e. [e -> ExprAttr] -> e -> [ExprAttr]
mkAttrs [
        forall a e.
RenderCabalOption a =>
Text -> (e -> [a]) -> e -> ExprAttr
multi Text
"dependencies" (forall a b. a -> b -> a
const [Dependency]
deps),
        forall a e.
RenderCabalOption a =>
Text -> (e -> [a]) -> e -> ExprAttr
multi Text
"default-extensions" (.defaultExtensions),
        forall a e.
RenderCabalOption a =>
Text -> (e -> [a]) -> e -> ExprAttr
multiOrSingle Text
"source-dirs" (.hsSourceDirs),
        forall a e.
RenderCabalOption a =>
Text -> (e -> Maybe a) -> e -> ExprAttr
singleOpt Text
"language" (.defaultLanguage),
        forall a e.
RenderCabalOption a =>
Text -> (e -> [a]) -> e -> ExprAttr
multi Text
"ghc-options" (forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
notDefaultGhcOption forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PerCompilerFlavor a -> a
ghcFlavour forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.options))
      ] BuildInfo
info
    (Maybe PreludeWithVersion
preludeWithVersion, [Dependency]
deps)
      | Just Prelude
p <- Maybe Prelude
prelude =
        let (Maybe Dependency
v, [Dependency]
res) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall {r}.
HasField "preludePackage" r String =>
r
-> (Maybe Dependency, [Dependency])
-> Dependency
-> (Maybe Dependency, [Dependency])
amendPrelude Prelude
p) (forall a. Maybe a
Nothing, []) BuildInfo
info.targetBuildDepends
        in (forall a. a -> Maybe a
Just (Prelude -> Maybe Dependency -> PreludeWithVersion
PreludeWithVersion Prelude
p Maybe Dependency
v), [Dependency]
res)
      | Bool
otherwise =
        (forall a. Maybe a
Nothing, forall a. (a -> Bool) -> [a] -> [a]
filter Dependency -> Bool
notBase (BuildInfo
info.targetBuildDepends))
    amendPrelude :: r
-> (Maybe Dependency, [Dependency])
-> Dependency
-> (Maybe Dependency, [Dependency])
amendPrelude r
p (Maybe Dependency
Nothing, [Dependency]
ds) dep :: Dependency
dep@(Dependency (PackageName -> String
Cabal.unPackageName -> String
dname) VersionRange
_ NonEmptySet LibraryName
_) | String
dname forall a. Eq a => a -> a -> Bool
== r
p.preludePackage =
      (forall a. a -> Maybe a
Just Dependency
dep, [Dependency]
ds)
    amendPrelude r
_ (Maybe Dependency
v, [Dependency]
ds) Dependency
d = (Maybe Dependency
v, Dependency
d forall a. a -> [a] -> [a]
: [Dependency]
ds)

notBase :: Cabal.Dependency -> Bool
notBase :: Dependency -> Bool
notBase = \case
  Cabal.Dependency PackageName
"base" VersionRange
_ NonEmptySet LibraryName
_ -> Bool
False
  Dependency
_ -> Bool
True

convertComponent :: ComponentType -> BuildInfo -> HixComponent
convertComponent :: ComponentType -> BuildInfo -> HixComponent
convertComponent ComponentType
special BuildInfo
info =
  HixComponent {[ExprAttr]
Maybe PreludeWithVersion
ComponentType
known :: [ExprAttr]
prelude :: Maybe PreludeWithVersion
special :: ComponentType
$sel:prelude:HixComponent :: Maybe PreludeWithVersion
$sel:known:HixComponent :: [ExprAttr]
$sel:special:HixComponent :: ComponentType
..}
  where
    (Maybe PreludeWithVersion
prelude, [ExprAttr]
known) = Maybe Prelude
-> BuildInfo -> (Maybe PreludeWithVersion, [ExprAttr])
knownComponentKeys Maybe Prelude
preludeBasic BuildInfo
info
    preludeBasic :: Maybe Prelude
preludeBasic = [Mixin] -> Maybe Prelude
findPrelude BuildInfo
info.mixins

convertLibrary :: Cabal.Library -> HixComponent
convertLibrary :: Library -> HixComponent
convertLibrary Library
lib =
  ComponentType -> BuildInfo -> HixComponent
convertComponent ComponentType
Library Library
lib.libBuildInfo

convertExecutable :: UnqualComponentName -> Cabal.Executable -> HixComponent
convertExecutable :: UnqualComponentName -> Executable -> HixComponent
convertExecutable UnqualComponentName
name Executable
exe =
  ComponentType -> BuildInfo -> HixComponent
convertComponent (Text -> ComponentType
Executable (forall a. ToText a => a -> Text
toText (UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
name))) Executable
exe.buildInfo

convertTestsuite :: UnqualComponentName -> Cabal.TestSuite -> HixComponent
convertTestsuite :: UnqualComponentName -> TestSuite -> HixComponent
convertTestsuite UnqualComponentName
name TestSuite
test =
  ComponentType -> BuildInfo -> HixComponent
convertComponent (Text -> ComponentType
Test (forall a. ToText a => a -> Text
toText (UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
name))) TestSuite
test.testBuildInfo

convertBenchmark :: UnqualComponentName -> Cabal.Benchmark -> HixComponent
convertBenchmark :: UnqualComponentName -> Benchmark -> HixComponent
convertBenchmark UnqualComponentName
name Benchmark
bench =
  ComponentType -> BuildInfo -> HixComponent
convertComponent (Text -> ComponentType
Benchmark (forall a. ToText a => a -> Text
toText (UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
name))) Benchmark
bench.benchmarkBuildInfo

convert :: CabalInfo -> HixPackage
convert :: CabalInfo -> HixPackage
convert CabalInfo
cinfo =
  HixPackage {
    $sel:name:HixPackage :: PackageName
name = Text -> PackageName
PackageName (forall a. ToText a => a -> Text
toText (PackageName -> String
unPackageName PackageDescription
pkg.package.pkgName)),
    $sel:src:HixPackage :: Path Rel Dir
src = CabalInfo
cinfo.path,
    $sel:known:HixPackage :: [ExprAttr]
known = PackageDescription -> [ExprAttr]
knownPackageKeys PackageDescription
pkg,
    $sel:meta:HixPackage :: [ExprAttr]
meta = PackageDescription -> [ExprAttr]
metaPackageKeys PackageDescription
pkg,
    $sel:description:HixPackage :: ExprAttr
description = forall a e.
RenderCabalOption a =>
Text -> (e -> a) -> e -> ExprAttr
single Text
"description" (.description) PackageDescription
pkg,
    [HixComponent]
components :: [HixComponent]
$sel:components:HixPackage :: [HixComponent]
components
  }
  where
    components :: [HixComponent]
components =
      forall a. Maybe a -> [a]
maybeToList (Library -> HixComponent
convertLibrary forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.condTreeData) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
info.condLibrary)
      forall a. Semigroup a => a -> a -> a
<>
      (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry UnqualComponentName -> Executable -> HixComponent
convertExecutable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (.condTreeData) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
info.condExecutables)
      forall a. Semigroup a => a -> a -> a
<>
      (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry UnqualComponentName -> TestSuite -> HixComponent
convertTestsuite forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (.condTreeData) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
info.condTestSuites)
      forall a. Semigroup a => a -> a -> a
<>
      (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry UnqualComponentName -> Benchmark -> HixComponent
convertBenchmark forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (.condTreeData) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
info.condBenchmarks)
    pkg :: PackageDescription
pkg = GenericPackageDescription
info.packageDescription
    info :: GenericPackageDescription
info = CabalInfo
cinfo.info

renderComponent :: HixComponent -> ExprAttr
renderComponent :: HixComponent -> ExprAttr
renderComponent HixComponent {[ExprAttr]
Maybe PreludeWithVersion
ComponentType
prelude :: Maybe PreludeWithVersion
known :: [ExprAttr]
special :: ComponentType
$sel:prelude:HixComponent :: HixComponent -> Maybe PreludeWithVersion
$sel:known:HixComponent :: HixComponent -> [ExprAttr]
$sel:special:HixComponent :: HixComponent -> ComponentType
..} =
  Text -> Expr -> ExprAttr
ExprAttr Text
key Expr
cabalConfig
  where
    cabalConfig :: Expr
cabalConfig = [ExprAttr] -> Expr
ExprAttrs ([ExprAttr]
known forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {l} {a} {a} {r} {r}.
(Item l ~ ExprAttr, ToText a, ToText a, IsList l,
 HasField "prelude" r r, HasField "preludePackage" r a,
 HasField "preludeModule" r a,
 HasField "dep" r (Maybe Dependency)) =>
r -> l
preludeAttrs Maybe PreludeWithVersion
prelude)
    preludeAttrs :: r -> l
preludeAttrs r
p =
      [Text -> Expr -> ExprAttr
ExprAttr Text
"prelude" ([ExprAttr] -> Expr
ExprAttrs [
        Text -> Expr -> ExprAttr
ExprAttr Text
"package" (forall {r} {r} {a}.
(HasField "prelude" r r, HasField "preludePackage" r a,
 HasField "dep" r (Maybe Dependency), ToText a) =>
r -> Expr
preludePackageAttrs r
p),
        Text -> Expr -> ExprAttr
ExprAttr Text
"module" (Text -> Expr
ExprString (forall a. ToText a => a -> Text
toText r
p.prelude.preludeModule))
      ])]
    preludePackageAttrs :: r -> Expr
preludePackageAttrs r
p
      | Just Dependency
dep <- r
p.dep =
        [ExprAttr] -> Expr
ExprAttrs [
          (Text -> Expr -> ExprAttr
ExprAttr Text
"name" (Text -> Expr
ExprString (forall a. ToText a => a -> Text
toText r
p.prelude.preludePackage))),
          (Text -> Expr -> ExprAttr
ExprAttr Text
"version" (Text -> Expr
ExprString (forall b a. (Show a, IsString b) => a -> b
show (forall a. Pretty a => a -> Doc
pretty (Dependency -> VersionRange
depVerRange Dependency
dep)))))
        ]
      | Bool
otherwise = Text -> Expr
ExprString (forall a. ToText a => a -> Text
toText r
p.prelude.preludePackage)
    key :: Text
key = case ComponentType
special of
      ComponentType
Library -> Text
"library"
      Executable Text
name -> [exon|executables.#{name}|]
      Test Text
name -> [exon|tests.#{name}|]
      Benchmark Text
name -> [exon|benchmarks.#{name}|]

flakePackage :: HixPackage -> ExprAttr
flakePackage :: HixPackage -> ExprAttr
flakePackage HixPackage
pkg =
  Text -> Expr -> ExprAttr
ExprAttr Text
name Expr
attrs
  where
    attrs :: Expr
attrs = [ExprAttr] -> Expr
ExprAttrs (ExprAttr
src forall a. a -> [a] -> [a]
: HixPackage
pkg.description forall a. a -> [a] -> [a]
: (Text -> Expr -> ExprAttr
ExprAttr Text
"cabal" Expr
cabalConfig forall a. a -> [a] -> [a]
: [ExprAttr]
comps))
    name :: Text
name = HixPackage
pkg.name.unPackageName
    src :: ExprAttr
src = Text -> Expr -> ExprAttr
ExprAttr Text
"src" (Text -> Expr
ExprLit [exon|./#{Text.dropWhileEnd ('/' ==) (pathText pkg.src)}|])
    cabalConfig :: Expr
cabalConfig = [ExprAttr] -> Expr
ExprAttrs (HixPackage
pkg.known forall a. Semigroup a => a -> a -> a
<> (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null HixPackage
pkg.meta then [] else [Text -> Expr -> ExprAttr
ExprAttr Text
"meta" ([ExprAttr] -> Expr
ExprAttrs HixPackage
pkg.meta)]))
    comps :: [ExprAttr]
comps = HixComponent -> ExprAttr
renderComponent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HixPackage
pkg.components

mainPackage :: [HixPackage] -> ExprAttr
mainPackage :: [HixPackage] -> ExprAttr
mainPackage = \case
  HixPackage
pkg : HixPackage
_ : [HixPackage]
_ -> Text -> Expr -> ExprAttr
ExprAttr Text
"main" (Text -> Expr
ExprString HixPackage
pkg.name.unPackageName)
  [HixPackage]
_ -> ExprAttr
ExprAttrNil

flake :: BootstrapProjectConfig -> [HixPackage] -> Expr
flake :: BootstrapProjectConfig -> [HixPackage] -> Expr
flake BootstrapProjectConfig
conf [HixPackage]
pkgs =
  [ExprAttr] -> Expr
ExprAttrs [
    (Text -> Expr -> ExprAttr
ExprAttr Text
"description" (Text -> Expr
ExprString Text
"A Haskell project")),
    (Text -> Expr -> ExprAttr
ExprAttr Text
"inputs.hix.url" (Text -> Expr
ExprString BootstrapProjectConfig
conf.hixUrl.unHixUrl)),
    (Text -> Expr -> ExprAttr
ExprAttr Text
"outputs" (Text -> Expr -> Expr
ExprPrefix Text
"{hix, ...}: hix.lib.flake" ([ExprAttr] -> Expr
ExprAttrs [
      (Text -> Expr -> ExprAttr
ExprAttr Text
"packages" ([ExprAttr] -> Expr
ExprAttrs (HixPackage -> ExprAttr
flakePackage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HixPackage]
pkgs))),
      [HixPackage] -> ExprAttr
mainPackage [HixPackage]
pkgs
    ])))
  ]

bootstrapFiles :: BootstrapProjectConfig -> M [ProjectFile]
bootstrapFiles :: BootstrapProjectConfig -> M [ProjectFile]
bootstrapFiles BootstrapProjectConfig
conf = do
  Env {Path Abs Dir
$sel:root:Env :: Env -> Path Abs Dir
root :: Path Abs Dir
root} <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  [Path Rel File]
cabals <- [String] -> ReaderT Env (ExceptT Error IO) [Path Rel File]
paths forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall a. IO a -> ExceptT Error IO a
tryIO (String -> [String] -> [String] -> IO [String]
getDirectoryFilesIgnore (forall b t. Path b t -> String
toFilePath Path Abs Dir
root) [String
"**/*.cabal"] [String
"dist-newstyle/**"]))
  [HixPackage]
pkgs <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CabalInfo -> HixPackage
convert forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Path Abs Dir -> Path Rel File -> M CabalInfo
readCabal Path Abs Dir
root) [Path Rel File]
cabals
  pure [
    ProjectFile {$sel:path:ProjectFile :: Path Rel File
path = [relfile|flake.nix|], $sel:content:ProjectFile :: Text
content = Expr -> Text
renderRootExpr (BootstrapProjectConfig -> [HixPackage] -> Expr
flake BootstrapProjectConfig
conf [HixPackage]
pkgs)}
    ]
  where
    paths :: [String] -> ReaderT Env (ExceptT Error IO) [Path Rel File]
paths = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a. Text -> Maybe a -> M a
noteBootstrap Text
"File path error" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile)

bootstrapProject :: BootstrapProjectConfig -> M ()
bootstrapProject :: BootstrapProjectConfig -> M ()
bootstrapProject BootstrapProjectConfig
conf =
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ProjectFile -> M ()
createFile forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BootstrapProjectConfig -> M [ProjectFile]
bootstrapFiles BootstrapProjectConfig
conf