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

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

exprStrings :: [Text] -> Expr
exprStrings :: [Text] -> Expr
exprStrings =
  [Expr] -> Expr
ExprList ([Expr] -> Expr) -> ([Text] -> [Expr]) -> [Text] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Expr) -> [Text] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
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
(CabalInfo -> CabalInfo -> Bool)
-> (CabalInfo -> CabalInfo -> Bool) -> Eq CabalInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CabalInfo -> CabalInfo -> Bool
== :: CabalInfo -> CabalInfo -> Bool
$c/= :: CabalInfo -> CabalInfo -> Bool
/= :: CabalInfo -> CabalInfo -> Bool
Eq, Int -> CabalInfo -> ShowS
[CabalInfo] -> ShowS
CabalInfo -> String
(Int -> CabalInfo -> ShowS)
-> (CabalInfo -> String)
-> ([CabalInfo] -> ShowS)
-> Show CabalInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CabalInfo -> ShowS
showsPrec :: Int -> CabalInfo -> ShowS
$cshow :: CabalInfo -> String
show :: CabalInfo -> String
$cshowList :: [CabalInfo] -> ShowS
showList :: [CabalInfo] -> ShowS
Show, (forall x. CabalInfo -> Rep CabalInfo x)
-> (forall x. Rep CabalInfo x -> CabalInfo) -> Generic CabalInfo
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
$cfrom :: forall x. CabalInfo -> Rep CabalInfo x
from :: forall x. CabalInfo -> Rep CabalInfo x
$cto :: forall x. Rep CabalInfo x -> CabalInfo
to :: forall x. Rep CabalInfo x -> CabalInfo
Generic)

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

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

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

indent ::
  Functor t =>
  Int ->
  t Text ->
  t Text
indent :: forall (t :: * -> *). Functor t => Int -> t Text -> t Text
indent Int
n =
  (Text -> Text) -> t Text -> t Text
forall a b. (a -> b) -> t a -> t b
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";"]
  Text
h :| Text
h1 : [Text]
t -> Text
h Text -> NonEmpty Text -> NonEmpty Text
forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty Text -> NonEmpty Text
withSemicolon (Text
h1 Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text]
t)

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

renderRootExpr :: Expr -> Text
renderRootExpr :: Expr -> Text
renderRootExpr =
  [Text] -> Text
Text.unlines ([Text] -> Text) -> (Expr -> [Text]) -> Expr -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Text -> [Text])
-> (Expr -> NonEmpty Text) -> Expr -> [Text]
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
cwd Path Rel File
path = do
  GenericPackageDescription
info <- IO GenericPackageDescription
-> ReaderT Env (ExceptT Error IO) GenericPackageDescription
forall a. IO a -> ReaderT Env (ExceptT Error IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Verbosity -> String -> IO GenericPackageDescription
readGenericPackageDescription Verbosity
Cabal.verbose (Path Abs File -> String
forall b t. Path b t -> String
toFilePath (Path Abs Dir
cwd Path Abs Dir -> Path Rel File -> Path Abs File
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
$sel:info:CabalInfo :: GenericPackageDescription
info :: GenericPackageDescription
info}
  where
    dir :: Path Rel Dir
dir = Path Rel File -> Path Rel 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 = Doc -> Text
forall b a. (Show a, IsString b) => a -> b
show (Doc -> Text) -> (a -> Doc) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a. Pretty a => a -> Doc
pretty

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

instance RenderCabalOption String where
  renderCabalOption :: String -> Text
renderCabalOption = String -> Text
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 | [Expr] -> Bool
forall a. [a] -> Bool
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 =
  ExprAttr -> (Text -> ExprAttr) -> Maybe Text -> ExprAttr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ExprAttr
ExprAttrNil (Text -> Expr -> ExprAttr
checkEmpty Text
key (Expr -> ExprAttr) -> (Text -> Expr) -> Text -> ExprAttr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Expr
ExprString) (a -> Text
forall a. RenderCabalOption a => a -> Text
renderCabalOption (a -> Text) -> Maybe a -> Maybe Text
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 =
  Text -> (e -> Maybe a) -> e -> ExprAttr
forall a e.
RenderCabalOption a =>
Text -> (e -> Maybe a) -> e -> ExprAttr
singleOpt Text
key (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (e -> a) -> e -> Maybe a
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 =
  ExprAttr -> ([Text] -> ExprAttr) -> Maybe [Text] -> ExprAttr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ExprAttr
ExprAttrNil (Text -> Expr -> ExprAttr
checkEmpty Text
key (Expr -> ExprAttr) -> ([Text] -> Expr) -> [Text] -> ExprAttr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Expr
exprStrings) ((a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Text
forall a. RenderCabalOption a => a -> Text
renderCabalOption ([a] -> [Text]) -> Maybe [a] -> Maybe [Text]
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 =
  Text -> (e -> Maybe [a]) -> e -> ExprAttr
forall a e.
RenderCabalOption a =>
Text -> (e -> Maybe [a]) -> e -> ExprAttr
multiOpt Text
key ([a] -> Maybe [a]
forall a. a -> Maybe a
Just ([a] -> Maybe [a]) -> (e -> [a]) -> e -> Maybe [a]
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 (a -> Text
forall a. RenderCabalOption a => a -> Text
renderCabalOption (a -> Text) -> [a] -> [Text]
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 Text
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 =
  (((e -> ExprAttr) -> ExprAttr) -> [e -> ExprAttr] -> [ExprAttr]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((e -> ExprAttr) -> e -> ExprAttr
forall a b. (a -> b) -> a -> b
$ e
e) [e -> ExprAttr]
a)

notNil :: ExprAttr -> Bool
notNil :: ExprAttr -> Bool
notNil = \case
  ExprAttr
ExprAttrNil -> Bool
False
  ExprAttr
_ -> Bool
True

nonEmptyAttrs :: Text -> [ExprAttr] -> ExprAttr
nonEmptyAttrs :: Text -> [ExprAttr] -> ExprAttr
nonEmptyAttrs Text
key =
  (ExprAttr -> Bool) -> [ExprAttr] -> [ExprAttr]
forall a. (a -> Bool) -> [a] -> [a]
filter ExprAttr -> Bool
notNil ([ExprAttr] -> [ExprAttr])
-> ([ExprAttr] -> ExprAttr) -> [ExprAttr] -> ExprAttr
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \case
    [] -> ExprAttr
ExprAttrNil
    [ExprAttr]
as -> Text -> Expr -> ExprAttr
ExprAttr Text
key ([ExprAttr] -> Expr
ExprAttrs [ExprAttr]
as)

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

metaPackageKeys :: PackageDescription -> [ExprAttr]
metaPackageKeys :: PackageDescription -> [ExprAttr]
metaPackageKeys =
  [PackageDescription -> ExprAttr]
-> PackageDescription -> [ExprAttr]
forall e. [e -> ExprAttr] -> e -> [ExprAttr]
mkAttrs [
    Text
-> (PackageDescription -> ShortText)
-> PackageDescription
-> ExprAttr
forall a e.
RenderCabalOption a =>
Text -> (e -> a) -> e -> ExprAttr
single Text
"maintainer" (.maintainer),
    Text
-> (PackageDescription -> ShortText)
-> PackageDescription
-> ExprAttr
forall a e.
RenderCabalOption a =>
Text -> (e -> a) -> e -> ExprAttr
single Text
"homepage" (.homepage),
    Text
-> (PackageDescription -> ShortText)
-> PackageDescription
-> ExprAttr
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 =
      [BuildInfo -> ExprAttr] -> BuildInfo -> [ExprAttr]
forall e. [e -> ExprAttr] -> e -> [ExprAttr]
mkAttrs [
        Text -> (BuildInfo -> [Dependency]) -> BuildInfo -> ExprAttr
forall a e.
RenderCabalOption a =>
Text -> (e -> [a]) -> e -> ExprAttr
multi Text
"dependencies" ([Dependency] -> BuildInfo -> [Dependency]
forall a b. a -> b -> a
const [Dependency]
deps),
        Text -> (BuildInfo -> [Extension]) -> BuildInfo -> ExprAttr
forall a e.
RenderCabalOption a =>
Text -> (e -> [a]) -> e -> ExprAttr
multi Text
"default-extensions" (.defaultExtensions),
        Text
-> (BuildInfo -> [SymbolicPath PackageDir SourceDir])
-> BuildInfo
-> ExprAttr
forall a e.
RenderCabalOption a =>
Text -> (e -> [a]) -> e -> ExprAttr
multiOrSingle Text
"source-dirs" (.hsSourceDirs),
        Text -> (BuildInfo -> Maybe Language) -> BuildInfo -> ExprAttr
forall a e.
RenderCabalOption a =>
Text -> (e -> Maybe a) -> e -> ExprAttr
singleOpt Text
"language" (.defaultLanguage),
        Text -> (BuildInfo -> [String]) -> BuildInfo -> ExprAttr
forall a e.
RenderCabalOption a =>
Text -> (e -> [a]) -> e -> ExprAttr
multi Text
"ghc-options" ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
notDefaultGhcOption ([String] -> [String])
-> (BuildInfo -> [String]) -> BuildInfo -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerCompilerFlavor [String] -> [String]
forall a. PerCompilerFlavor a -> a
ghcFlavour (PerCompilerFlavor [String] -> [String])
-> (BuildInfo -> PerCompilerFlavor [String])
-> BuildInfo
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.options)),
        Item [BuildInfo -> ExprAttr]
BuildInfo -> ExprAttr
forall {a} {e}.
(RenderCabalOption a, HasField "otherModules" e [a]) =>
e -> ExprAttr
misc
      ] BuildInfo
info

    misc :: e -> ExprAttr
misc e
e =
      Text -> [ExprAttr] -> ExprAttr
nonEmptyAttrs Text
"component" ([e -> ExprAttr] -> e -> [ExprAttr]
forall e. [e -> ExprAttr] -> e -> [ExprAttr]
mkAttrs [
        Text -> (e -> [a]) -> e -> ExprAttr
forall a e.
RenderCabalOption a =>
Text -> (e -> [a]) -> e -> ExprAttr
multi Text
"other-modules" (.otherModules)
      ] e
e)

    (Maybe PreludeWithVersion
preludeWithVersion, [Dependency]
deps)
      | Just Prelude
p <- Maybe Prelude
prelude =
        let (Maybe Dependency
v, [Dependency]
res) = ((Maybe Dependency, [Dependency])
 -> Dependency -> (Maybe Dependency, [Dependency]))
-> (Maybe Dependency, [Dependency])
-> [Dependency]
-> (Maybe Dependency, [Dependency])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Prelude
-> (Maybe Dependency, [Dependency])
-> Dependency
-> (Maybe Dependency, [Dependency])
forall {r}.
HasField "preludePackage" r String =>
r
-> (Maybe Dependency, [Dependency])
-> Dependency
-> (Maybe Dependency, [Dependency])
amendPrelude Prelude
p) (Maybe Dependency
forall a. Maybe a
Nothing, []) BuildInfo
info.targetBuildDepends
        in (PreludeWithVersion -> Maybe PreludeWithVersion
forall a. a -> Maybe a
Just (Prelude -> Maybe Dependency -> PreludeWithVersion
PreludeWithVersion Prelude
p Maybe Dependency
v), [Dependency]
res)
      | Bool
otherwise =
        (Maybe PreludeWithVersion
forall a. Maybe a
Nothing, (Dependency -> Bool) -> [Dependency] -> [Dependency]
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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== r
p.preludePackage =
      (Dependency -> Maybe Dependency
forall a. a -> Maybe a
Just Dependency
dep, [Dependency]
ds)
    amendPrelude r
_ (Maybe Dependency
v, [Dependency]
ds) Dependency
d = (Maybe Dependency
v, Dependency
d Dependency -> [Dependency] -> [Dependency]
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 -> [ExprAttr] -> HixComponent
convertComponent :: ComponentType -> BuildInfo -> [ExprAttr] -> HixComponent
convertComponent ComponentType
special BuildInfo
info [ExprAttr]
extra =
  HixComponent {$sel:known:HixComponent :: [ExprAttr]
known = [ExprAttr]
knownCommon [ExprAttr] -> [ExprAttr] -> [ExprAttr]
forall a. Semigroup a => a -> a -> a
<> [ExprAttr]
extra, Maybe PreludeWithVersion
ComponentType
$sel:special:HixComponent :: ComponentType
$sel:prelude:HixComponent :: Maybe PreludeWithVersion
special :: ComponentType
prelude :: Maybe PreludeWithVersion
..}
  where
    (Maybe PreludeWithVersion
prelude, [ExprAttr]
knownCommon) = 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 -> [ExprAttr] -> HixComponent
convertComponent ComponentType
Library Library
lib.libBuildInfo [ExprAttr]
extra
  where
    extra :: [ExprAttr]
extra = [Library -> ExprAttr] -> Library -> [ExprAttr]
forall e. [e -> ExprAttr] -> e -> [ExprAttr]
mkAttrs [
      Text -> (Library -> [ModuleReexport]) -> Library -> ExprAttr
forall a e.
RenderCabalOption a =>
Text -> (e -> [a]) -> e -> ExprAttr
multi Text
"reexported-modules" (.reexportedModules)
      ] Library
lib

convertExecutable :: UnqualComponentName -> Cabal.Executable -> HixComponent
convertExecutable :: UnqualComponentName -> Executable -> HixComponent
convertExecutable UnqualComponentName
name Executable
exe =
  ComponentType -> BuildInfo -> [ExprAttr] -> HixComponent
convertComponent (Text -> ComponentType
Executable (String -> Text
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 -> [ExprAttr] -> HixComponent
convertComponent (Text -> ComponentType
Test (String -> Text
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 -> [ExprAttr] -> HixComponent
convertComponent (Text -> ComponentType
Benchmark (String -> Text
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 (String -> Text
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 = Text
-> (PackageDescription -> ShortText)
-> PackageDescription
-> ExprAttr
forall a e.
RenderCabalOption a =>
Text -> (e -> a) -> e -> ExprAttr
single Text
"description" (.description) PackageDescription
pkg,
    [HixComponent]
$sel:components:HixPackage :: [HixComponent]
components :: [HixComponent]
components
  }
  where
    components :: [HixComponent]
components =
      Maybe HixComponent -> [HixComponent]
forall a. Maybe a -> [a]
maybeToList (Library -> HixComponent
convertLibrary (Library -> HixComponent)
-> (CondTree ConfVar [Dependency] Library -> Library)
-> CondTree ConfVar [Dependency] Library
-> HixComponent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.condTreeData) (CondTree ConfVar [Dependency] Library -> HixComponent)
-> Maybe (CondTree ConfVar [Dependency] Library)
-> Maybe HixComponent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
info.condLibrary)
      [HixComponent] -> [HixComponent] -> [HixComponent]
forall a. Semigroup a => a -> a -> a
<>
      ((UnqualComponentName -> Executable -> HixComponent)
-> (UnqualComponentName, Executable) -> HixComponent
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry UnqualComponentName -> Executable -> HixComponent
convertExecutable ((UnqualComponentName, Executable) -> HixComponent)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
    -> (UnqualComponentName, Executable))
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> HixComponent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CondTree ConfVar [Dependency] Executable -> Executable)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> (UnqualComponentName, Executable)
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) ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
 -> HixComponent)
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> [HixComponent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
info.condExecutables)
      [HixComponent] -> [HixComponent] -> [HixComponent]
forall a. Semigroup a => a -> a -> a
<>
      ((UnqualComponentName -> TestSuite -> HixComponent)
-> (UnqualComponentName, TestSuite) -> HixComponent
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry UnqualComponentName -> TestSuite -> HixComponent
convertTestsuite ((UnqualComponentName, TestSuite) -> HixComponent)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
    -> (UnqualComponentName, TestSuite))
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> HixComponent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CondTree ConfVar [Dependency] TestSuite -> TestSuite)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> (UnqualComponentName, TestSuite)
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) ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
 -> HixComponent)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [HixComponent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
info.condTestSuites)
      [HixComponent] -> [HixComponent] -> [HixComponent]
forall a. Semigroup a => a -> a -> a
<>
      ((UnqualComponentName -> Benchmark -> HixComponent)
-> (UnqualComponentName, Benchmark) -> HixComponent
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry UnqualComponentName -> Benchmark -> HixComponent
convertBenchmark ((UnqualComponentName, Benchmark) -> HixComponent)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
    -> (UnqualComponentName, Benchmark))
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> HixComponent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CondTree ConfVar [Dependency] Benchmark -> Benchmark)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> (UnqualComponentName, Benchmark)
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) ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
 -> HixComponent)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [HixComponent]
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
$sel:special:HixComponent :: HixComponent -> ComponentType
$sel:known:HixComponent :: HixComponent -> [ExprAttr]
$sel:prelude:HixComponent :: HixComponent -> Maybe PreludeWithVersion
special :: ComponentType
known :: [ExprAttr]
prelude :: Maybe PreludeWithVersion
..} =
  Text -> Expr -> ExprAttr
ExprAttr Text
key Expr
cabalConfig
  where
    cabalConfig :: Expr
cabalConfig = [ExprAttr] -> Expr
ExprAttrs ([ExprAttr]
enable [ExprAttr] -> [ExprAttr] -> [ExprAttr]
forall a. Semigroup a => a -> a -> a
<> (PreludeWithVersion -> [ExprAttr])
-> Maybe PreludeWithVersion -> [ExprAttr]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap PreludeWithVersion -> [ExprAttr]
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 [ExprAttr] -> [ExprAttr] -> [ExprAttr]
forall a. Semigroup a => a -> a -> a
<> [ExprAttr]
known)
    preludeAttrs :: r -> l
preludeAttrs r
p =
      [Text -> Expr -> ExprAttr
ExprAttr Text
"prelude" ([ExprAttr] -> Expr
ExprAttrs [
        Text -> Expr -> ExprAttr
ExprAttr Text
"package" (r -> Expr
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 (a -> Text
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 (a -> Text
forall a. ToText a => a -> Text
toText r
p.prelude.preludePackage))),
          (Text -> Expr -> ExprAttr
ExprAttr Text
"version" (Text -> Expr
ExprString (Doc -> Text
forall b a. (Show a, IsString b) => a -> b
show (VersionRange -> Doc
forall a. Pretty a => a -> Doc
pretty (Dependency -> VersionRange
depVerRange Dependency
dep)))))
        ]
      | Bool
otherwise = Text -> Expr
ExprString (a -> Text
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}|]
    enable :: [ExprAttr]
enable = case ComponentType
special of
      ComponentType
Library -> [Text -> Expr -> ExprAttr
ExprAttr Text
"enable" (Text -> Expr
ExprLit Text
"true")]
      ComponentType
_ -> []

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 ExprAttr -> [ExprAttr] -> [ExprAttr]
forall a. a -> [a] -> [a]
: HixPackage
pkg.description ExprAttr -> [ExprAttr] -> [ExprAttr]
forall a. a -> [a] -> [a]
: (Text -> Expr -> ExprAttr
ExprAttr Text
"cabal" Expr
cabalConfig ExprAttr -> [ExprAttr] -> [ExprAttr]
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 [ExprAttr] -> [ExprAttr] -> [ExprAttr]
forall a. Semigroup a => a -> a -> a
<> (if [ExprAttr] -> Bool
forall a. [a] -> Bool
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 (HixComponent -> ExprAttr) -> [HixComponent] -> [ExprAttr]
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 (HixPackage -> ExprAttr) -> [HixPackage] -> [ExprAttr]
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
cwd :: Path Abs Dir
$sel:cwd:Env :: Env -> Path Abs Dir
cwd} <- ReaderT Env (ExceptT Error IO) Env
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  [Path Rel File]
cabals <- [String] -> ReaderT Env (ExceptT Error IO) [Path Rel File]
paths ([String] -> ReaderT Env (ExceptT Error IO) [Path Rel File])
-> ReaderT Env (ExceptT Error IO) [String]
-> ReaderT Env (ExceptT Error IO) [Path Rel File]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExceptT Error IO [String]
-> ReaderT Env (ExceptT Error IO) [String]
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 [String] -> ExceptT Error IO [String]
forall a. IO a -> ExceptT Error IO a
tryIO (String -> [String] -> [String] -> IO [String]
getDirectoryFilesIgnore (Path Abs Dir -> String
forall b t. Path b t -> String
toFilePath Path Abs Dir
cwd) [String
Item [String]
"**/*.cabal"] [String
Item [String]
"dist-newstyle/**"]))
  [HixPackage]
pkgs <- (CabalInfo -> HixPackage) -> [CabalInfo] -> [HixPackage]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CabalInfo -> HixPackage
convert ([CabalInfo] -> [HixPackage])
-> ReaderT Env (ExceptT Error IO) [CabalInfo]
-> ReaderT Env (ExceptT Error IO) [HixPackage]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Path Rel File -> M CabalInfo)
-> [Path Rel File] -> ReaderT Env (ExceptT Error IO) [CabalInfo]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Path Abs Dir -> Path Rel File -> M CabalInfo
readCabal Path Abs Dir
cwd) [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 = (String -> ReaderT Env (ExceptT Error IO) (Path Rel File))
-> [String] -> ReaderT Env (ExceptT Error IO) [Path Rel File]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Text
-> Maybe (Path Rel File)
-> ReaderT Env (ExceptT Error IO) (Path Rel File)
forall a. Text -> Maybe a -> M a
noteBootstrap Text
"File path error" (Maybe (Path Rel File)
 -> ReaderT Env (ExceptT Error IO) (Path Rel File))
-> (String -> Maybe (Path Rel File))
-> String
-> ReaderT Env (ExceptT Error IO) (Path Rel File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile)

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