{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module StackageToHackage.Stackage.Types where

import Data.List.NonEmpty (NonEmpty(..))
import Data.Map.Strict (Map)
import Data.Semigroup
import Data.Text (Text)
import Distribution.Types.PackageId (PackageIdentifier(..))
import Prelude hiding (head, reverse, takeWhile)


data Stack = Stack
  { Stack -> ResolverRef
resolver  :: ResolverRef
  , Stack -> Maybe Ghc
compiler  :: Maybe Ghc
  , Stack -> [Package]
packages  :: [Package]
  , Stack -> [Dep]
extraDeps :: [Dep]
  , Stack -> Flags
flags     :: Flags
  , Stack -> GhcOptions
ghcOptions :: GhcOptions
  } deriving (Int -> Stack -> ShowS
[Stack] -> ShowS
Stack -> String
(Int -> Stack -> ShowS)
-> (Stack -> String) -> ([Stack] -> ShowS) -> Show Stack
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stack] -> ShowS
$cshowList :: [Stack] -> ShowS
show :: Stack -> String
$cshow :: Stack -> String
showsPrec :: Int -> Stack -> ShowS
$cshowsPrec :: Int -> Stack -> ShowS
Show)


newtype Ghc = Ghc Text
  deriving (Int -> Ghc -> ShowS
[Ghc] -> ShowS
Ghc -> String
(Int -> Ghc -> ShowS)
-> (Ghc -> String) -> ([Ghc] -> ShowS) -> Show Ghc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ghc] -> ShowS
$cshowList :: [Ghc] -> ShowS
show :: Ghc -> String
$cshow :: Ghc -> String
showsPrec :: Int -> Ghc -> ShowS
$cshowsPrec :: Int -> Ghc -> ShowS
Show)


data Package = Local FilePath
             | Location Git
               deriving (Int -> Package -> ShowS
[Package] -> ShowS
Package -> String
(Int -> Package -> ShowS)
-> (Package -> String) -> ([Package] -> ShowS) -> Show Package
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Package] -> ShowS
$cshowList :: [Package] -> ShowS
show :: Package -> String
$cshow :: Package -> String
showsPrec :: Int -> Package -> ShowS
$cshowsPrec :: Int -> Package -> ShowS
Show)


data Git = Git
  { Git -> Repo
repo    :: Repo
  , Git -> Repo
commit  :: Commit
  , Git -> [Repo]
subdirs :: [Subdir]
  } deriving (Int -> Git -> ShowS
[Git] -> ShowS
Git -> String
(Int -> Git -> ShowS)
-> (Git -> String) -> ([Git] -> ShowS) -> Show Git
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Git] -> ShowS
$cshowList :: [Git] -> ShowS
show :: Git -> String
$cshow :: Git -> String
showsPrec :: Int -> Git -> ShowS
$cshowsPrec :: Int -> Git -> ShowS
Show, Git -> Git -> Bool
(Git -> Git -> Bool) -> (Git -> Git -> Bool) -> Eq Git
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Git -> Git -> Bool
$c/= :: Git -> Git -> Bool
== :: Git -> Git -> Bool
$c== :: Git -> Git -> Bool
Eq, Eq Git
Eq Git
-> (Git -> Git -> Ordering)
-> (Git -> Git -> Bool)
-> (Git -> Git -> Bool)
-> (Git -> Git -> Bool)
-> (Git -> Git -> Bool)
-> (Git -> Git -> Git)
-> (Git -> Git -> Git)
-> Ord Git
Git -> Git -> Bool
Git -> Git -> Ordering
Git -> Git -> Git
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Git -> Git -> Git
$cmin :: Git -> Git -> Git
max :: Git -> Git -> Git
$cmax :: Git -> Git -> Git
>= :: Git -> Git -> Bool
$c>= :: Git -> Git -> Bool
> :: Git -> Git -> Bool
$c> :: Git -> Git -> Bool
<= :: Git -> Git -> Bool
$c<= :: Git -> Git -> Bool
< :: Git -> Git -> Bool
$c< :: Git -> Git -> Bool
compare :: Git -> Git -> Ordering
$ccompare :: Git -> Git -> Ordering
$cp1Ord :: Eq Git
Ord)


type Repo = Text
type Commit = Text
type Subdir = Text


-- http://hackage.haskell.org/package/Cabal-2.4.1.0/docs/Distribution-Types-PackageId.html#t:PackageIdentifier
-- http://hackage.haskell.org/package/Cabal-2.4.1.0/docs/Distribution-Parsec-Class.html#v:simpleParsec

data Dep = Hackage PkgId
         | SourceDep Git
         | LocalDep FilePath
         deriving (Int -> Dep -> ShowS
[Dep] -> ShowS
Dep -> String
(Int -> Dep -> ShowS)
-> (Dep -> String) -> ([Dep] -> ShowS) -> Show Dep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dep] -> ShowS
$cshowList :: [Dep] -> ShowS
show :: Dep -> String
$cshow :: Dep -> String
showsPrec :: Int -> Dep -> ShowS
$cshowsPrec :: Int -> Dep -> ShowS
Show)


newtype Flags = Flags (Map PkgName (Map FlagName Bool))
              deriving (Int -> Flags -> ShowS
[Flags] -> ShowS
Flags -> String
(Int -> Flags -> ShowS)
-> (Flags -> String) -> ([Flags] -> ShowS) -> Show Flags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flags] -> ShowS
$cshowList :: [Flags] -> ShowS
show :: Flags -> String
$cshow :: Flags -> String
showsPrec :: Int -> Flags -> ShowS
$cshowsPrec :: Int -> Flags -> ShowS
Show)
              deriving newtype (b -> Flags -> Flags
NonEmpty Flags -> Flags
Flags -> Flags -> Flags
(Flags -> Flags -> Flags)
-> (NonEmpty Flags -> Flags)
-> (forall b. Integral b => b -> Flags -> Flags)
-> Semigroup Flags
forall b. Integral b => b -> Flags -> Flags
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Flags -> Flags
$cstimes :: forall b. Integral b => b -> Flags -> Flags
sconcat :: NonEmpty Flags -> Flags
$csconcat :: NonEmpty Flags -> Flags
<> :: Flags -> Flags -> Flags
$c<> :: Flags -> Flags -> Flags
Semigroup, Semigroup Flags
Flags
Semigroup Flags
-> Flags
-> (Flags -> Flags -> Flags)
-> ([Flags] -> Flags)
-> Monoid Flags
[Flags] -> Flags
Flags -> Flags -> Flags
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Flags] -> Flags
$cmconcat :: [Flags] -> Flags
mappend :: Flags -> Flags -> Flags
$cmappend :: Flags -> Flags -> Flags
mempty :: Flags
$cmempty :: Flags
$cp1Monoid :: Semigroup Flags
Monoid)


newtype PackageGhcOpts = PackageGhcOpts (Map PkgId GhcFlags)
              deriving (Int -> PackageGhcOpts -> ShowS
[PackageGhcOpts] -> ShowS
PackageGhcOpts -> String
(Int -> PackageGhcOpts -> ShowS)
-> (PackageGhcOpts -> String)
-> ([PackageGhcOpts] -> ShowS)
-> Show PackageGhcOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageGhcOpts] -> ShowS
$cshowList :: [PackageGhcOpts] -> ShowS
show :: PackageGhcOpts -> String
$cshow :: PackageGhcOpts -> String
showsPrec :: Int -> PackageGhcOpts -> ShowS
$cshowsPrec :: Int -> PackageGhcOpts -> ShowS
Show)
              deriving newtype (b -> PackageGhcOpts -> PackageGhcOpts
NonEmpty PackageGhcOpts -> PackageGhcOpts
PackageGhcOpts -> PackageGhcOpts -> PackageGhcOpts
(PackageGhcOpts -> PackageGhcOpts -> PackageGhcOpts)
-> (NonEmpty PackageGhcOpts -> PackageGhcOpts)
-> (forall b. Integral b => b -> PackageGhcOpts -> PackageGhcOpts)
-> Semigroup PackageGhcOpts
forall b. Integral b => b -> PackageGhcOpts -> PackageGhcOpts
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> PackageGhcOpts -> PackageGhcOpts
$cstimes :: forall b. Integral b => b -> PackageGhcOpts -> PackageGhcOpts
sconcat :: NonEmpty PackageGhcOpts -> PackageGhcOpts
$csconcat :: NonEmpty PackageGhcOpts -> PackageGhcOpts
<> :: PackageGhcOpts -> PackageGhcOpts -> PackageGhcOpts
$c<> :: PackageGhcOpts -> PackageGhcOpts -> PackageGhcOpts
Semigroup, Semigroup PackageGhcOpts
PackageGhcOpts
Semigroup PackageGhcOpts
-> PackageGhcOpts
-> (PackageGhcOpts -> PackageGhcOpts -> PackageGhcOpts)
-> ([PackageGhcOpts] -> PackageGhcOpts)
-> Monoid PackageGhcOpts
[PackageGhcOpts] -> PackageGhcOpts
PackageGhcOpts -> PackageGhcOpts -> PackageGhcOpts
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [PackageGhcOpts] -> PackageGhcOpts
$cmconcat :: [PackageGhcOpts] -> PackageGhcOpts
mappend :: PackageGhcOpts -> PackageGhcOpts -> PackageGhcOpts
$cmappend :: PackageGhcOpts -> PackageGhcOpts -> PackageGhcOpts
mempty :: PackageGhcOpts
$cmempty :: PackageGhcOpts
$cp1Monoid :: Semigroup PackageGhcOpts
Monoid)


data GhcOptions = GhcOptions
  { GhcOptions -> Maybe Repo
locals :: Maybe GhcFlags
  , GhcOptions -> Maybe Repo
targets :: Maybe GhcFlags  -- cabal doesn't know about these
  , GhcOptions -> Maybe Repo
everything :: Maybe GhcFlags
  , GhcOptions -> PackageGhcOpts
packagesGhcOpts :: PackageGhcOpts
  } deriving (Int -> GhcOptions -> ShowS
[GhcOptions] -> ShowS
GhcOptions -> String
(Int -> GhcOptions -> ShowS)
-> (GhcOptions -> String)
-> ([GhcOptions] -> ShowS)
-> Show GhcOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GhcOptions] -> ShowS
$cshowList :: [GhcOptions] -> ShowS
show :: GhcOptions -> String
$cshow :: GhcOptions -> String
showsPrec :: Int -> GhcOptions -> ShowS
$cshowsPrec :: Int -> GhcOptions -> ShowS
Show)

emptyGhcOptions :: GhcOptions
emptyGhcOptions :: GhcOptions
emptyGhcOptions = Maybe Repo
-> Maybe Repo -> Maybe Repo -> PackageGhcOpts -> GhcOptions
GhcOptions Maybe Repo
forall a. Maybe a
Nothing Maybe Repo
forall a. Maybe a
Nothing Maybe Repo
forall a. Maybe a
Nothing PackageGhcOpts
forall a. Monoid a => a
mempty

type PkgName = Text
type FlagName = Text
type GhcFlags = Text


newtype NewDep = NewDep PkgId deriving (Int -> NewDep -> ShowS
[NewDep] -> ShowS
NewDep -> String
(Int -> NewDep -> ShowS)
-> (NewDep -> String) -> ([NewDep] -> ShowS) -> Show NewDep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NewDep] -> ShowS
$cshowList :: [NewDep] -> ShowS
show :: NewDep -> String
$cshow :: NewDep -> String
showsPrec :: Int -> NewDep -> ShowS
$cshowsPrec :: Int -> NewDep -> ShowS
Show)


newtype PkgId = PkgId { PkgId -> PackageIdentifier
unPkgId :: PackageIdentifier } deriving (Int -> PkgId -> ShowS
[PkgId] -> ShowS
PkgId -> String
(Int -> PkgId -> ShowS)
-> (PkgId -> String) -> ([PkgId] -> ShowS) -> Show PkgId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PkgId] -> ShowS
$cshowList :: [PkgId] -> ShowS
show :: PkgId -> String
$cshow :: PkgId -> String
showsPrec :: Int -> PkgId -> ShowS
$cshowsPrec :: Int -> PkgId -> ShowS
Show, Eq PkgId
Eq PkgId
-> (PkgId -> PkgId -> Ordering)
-> (PkgId -> PkgId -> Bool)
-> (PkgId -> PkgId -> Bool)
-> (PkgId -> PkgId -> Bool)
-> (PkgId -> PkgId -> Bool)
-> (PkgId -> PkgId -> PkgId)
-> (PkgId -> PkgId -> PkgId)
-> Ord PkgId
PkgId -> PkgId -> Bool
PkgId -> PkgId -> Ordering
PkgId -> PkgId -> PkgId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PkgId -> PkgId -> PkgId
$cmin :: PkgId -> PkgId -> PkgId
max :: PkgId -> PkgId -> PkgId
$cmax :: PkgId -> PkgId -> PkgId
>= :: PkgId -> PkgId -> Bool
$c>= :: PkgId -> PkgId -> Bool
> :: PkgId -> PkgId -> Bool
$c> :: PkgId -> PkgId -> Bool
<= :: PkgId -> PkgId -> Bool
$c<= :: PkgId -> PkgId -> Bool
< :: PkgId -> PkgId -> Bool
$c< :: PkgId -> PkgId -> Bool
compare :: PkgId -> PkgId -> Ordering
$ccompare :: PkgId -> PkgId -> Ordering
$cp1Ord :: Eq PkgId
Ord, PkgId -> PkgId -> Bool
(PkgId -> PkgId -> Bool) -> (PkgId -> PkgId -> Bool) -> Eq PkgId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PkgId -> PkgId -> Bool
$c/= :: PkgId -> PkgId -> Bool
== :: PkgId -> PkgId -> Bool
$c== :: PkgId -> PkgId -> Bool
Eq)

--------------------------------------------------------------------------------
-- Resolvers

-- the format used at https://github.com/commercialhaskell/stackage-snapshots
-- which is similar to the Resolver format.
data NewResolver = NewResolver
  { NewResolver -> Ghc
compiler :: Ghc
  , NewResolver -> [NewDep]
packages :: [NewDep]
  , NewResolver -> Flags
flags    :: Flags
  } deriving (Int -> NewResolver -> ShowS
[NewResolver] -> ShowS
NewResolver -> String
(Int -> NewResolver -> ShowS)
-> (NewResolver -> String)
-> ([NewResolver] -> ShowS)
-> Show NewResolver
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NewResolver] -> ShowS
$cshowList :: [NewResolver] -> ShowS
show :: NewResolver -> String
$cshow :: NewResolver -> String
showsPrec :: Int -> NewResolver -> ShowS
$cshowsPrec :: Int -> NewResolver -> ShowS
Show)


data Resolver = Resolver
  { Resolver -> Maybe ResolverRef
resolver :: Maybe ResolverRef
  , Resolver -> Maybe Ghc
compiler :: Maybe Ghc
  , Resolver -> [Dep]
deps     :: [Dep]
  , Resolver -> Flags
flags    :: Flags
  } deriving (Int -> Resolver -> ShowS
[Resolver] -> ShowS
Resolver -> String
(Int -> Resolver -> ShowS)
-> (Resolver -> String) -> ([Resolver] -> ShowS) -> Show Resolver
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Resolver] -> ShowS
$cshowList :: [Resolver] -> ShowS
show :: Resolver -> String
$cshow :: Resolver -> String
showsPrec :: Int -> Resolver -> ShowS
$cshowsPrec :: Int -> Resolver -> ShowS
Show)


-- TODO: remote ResolverRefs
data ResolverRef = Canned Text
                 | Snapshot Text
                 deriving (Int -> ResolverRef -> ShowS
[ResolverRef] -> ShowS
ResolverRef -> String
(Int -> ResolverRef -> ShowS)
-> (ResolverRef -> String)
-> ([ResolverRef] -> ShowS)
-> Show ResolverRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResolverRef] -> ShowS
$cshowList :: [ResolverRef] -> ShowS
show :: ResolverRef -> String
$cshow :: ResolverRef -> String
showsPrec :: Int -> ResolverRef -> ShowS
$cshowsPrec :: Int -> ResolverRef -> ShowS
Show)


type RelativeResolvers = NonEmpty (Maybe FilePath, Resolver)
type Resolvers = NonEmpty Resolver