{-# Language PatternGuards #-}

module CabalBounds.Bound
   ( DropBound(..)
   , UpdateBound(..)
   , boundOfDrop
   , boundOfUpdate
   ) where

import CabalBounds.Args (Args(Drop, Update))
import qualified CabalBounds.Args as A
import CabalBounds.VersionComp (VersionComp(..), defaultLowerComp, defaultUpperComp)
import Data.Maybe (isJust)

data DropBound = DropUpper
               | DropBoth
               deriving (Int -> DropBound -> ShowS
[DropBound] -> ShowS
DropBound -> String
(Int -> DropBound -> ShowS)
-> (DropBound -> String)
-> ([DropBound] -> ShowS)
-> Show DropBound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DropBound -> ShowS
showsPrec :: Int -> DropBound -> ShowS
$cshow :: DropBound -> String
show :: DropBound -> String
$cshowList :: [DropBound] -> ShowS
showList :: [DropBound] -> ShowS
Show, DropBound -> DropBound -> Bool
(DropBound -> DropBound -> Bool)
-> (DropBound -> DropBound -> Bool) -> Eq DropBound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DropBound -> DropBound -> Bool
== :: DropBound -> DropBound -> Bool
$c/= :: DropBound -> DropBound -> Bool
/= :: DropBound -> DropBound -> Bool
Eq)


-- | The bound is only updated if it's missing.
type IfMissing = Bool

type LowerComp = VersionComp
type UpperComp = VersionComp

data UpdateBound = UpdateLower LowerComp IfMissing
                 | UpdateUpper UpperComp IfMissing
                 | UpdateBoth LowerComp UpperComp IfMissing
                 deriving (Int -> UpdateBound -> ShowS
[UpdateBound] -> ShowS
UpdateBound -> String
(Int -> UpdateBound -> ShowS)
-> (UpdateBound -> String)
-> ([UpdateBound] -> ShowS)
-> Show UpdateBound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateBound -> ShowS
showsPrec :: Int -> UpdateBound -> ShowS
$cshow :: UpdateBound -> String
show :: UpdateBound -> String
$cshowList :: [UpdateBound] -> ShowS
showList :: [UpdateBound] -> ShowS
Show, UpdateBound -> UpdateBound -> Bool
(UpdateBound -> UpdateBound -> Bool)
-> (UpdateBound -> UpdateBound -> Bool) -> Eq UpdateBound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateBound -> UpdateBound -> Bool
== :: UpdateBound -> UpdateBound -> Bool
$c/= :: UpdateBound -> UpdateBound -> Bool
/= :: UpdateBound -> UpdateBound -> Bool
Eq)


boundOfDrop :: Args -> DropBound
boundOfDrop :: Args -> DropBound
boundOfDrop Drop {upper :: Args -> Bool
A.upper = Bool
upper} = if Bool
upper then DropBound
DropUpper else DropBound
DropBoth
boundOfDrop Args
_  = String -> DropBound
forall a. HasCallStack => String -> a
error String
"Expected Drop Args!"


boundOfUpdate :: Args -> UpdateBound
boundOfUpdate :: Args -> UpdateBound
boundOfUpdate upd :: Args
upd@Update {}
   | Bool
hasLower Bool -> Bool -> Bool
&& Bool
hasUpper
   = LowerComp -> LowerComp -> Bool -> UpdateBound
UpdateBoth LowerComp
lowerComp LowerComp
upperComp Bool
ifMissing

   | Bool
hasLower
   = LowerComp -> Bool -> UpdateBound
UpdateLower LowerComp
lowerComp Bool
ifMissing

   | Bool
hasUpper
   = LowerComp -> Bool -> UpdateBound
UpdateUpper LowerComp
upperComp Bool
ifMissing

   | Bool
otherwise
   = LowerComp -> LowerComp -> Bool -> UpdateBound
UpdateBoth LowerComp
lowerComp LowerComp
upperComp Bool
ifMissing
   where
      lowerComp :: LowerComp
lowerComp
         | Just LowerComp
comp <- Args -> Maybe LowerComp
A.lowerComp Args
upd
         = LowerComp
comp

         | Bool
otherwise
         = LowerComp
defaultLowerComp

      upperComp :: LowerComp
upperComp
         | Just LowerComp
comp <- Args -> Maybe LowerComp
A.upperComp Args
upd
         = LowerComp
comp

         | Bool
otherwise
         = LowerComp
defaultUpperComp

      ifMissing :: Bool
ifMissing = Args -> Bool
A.missing Args
upd

      hasLower :: Bool
hasLower = Args -> Bool
A.lower Args
upd Bool -> Bool -> Bool
|| (Maybe LowerComp -> Bool
forall a. Maybe a -> Bool
isJust (Maybe LowerComp -> Bool)
-> (Args -> Maybe LowerComp) -> Args -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> Maybe LowerComp
A.lowerComp (Args -> Bool) -> Args -> Bool
forall a b. (a -> b) -> a -> b
$ Args
upd)
      hasUpper :: Bool
hasUpper = Args -> Bool
A.upper Args
upd Bool -> Bool -> Bool
|| (Maybe LowerComp -> Bool
forall a. Maybe a -> Bool
isJust (Maybe LowerComp -> Bool)
-> (Args -> Maybe LowerComp) -> Args -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> Maybe LowerComp
A.upperComp (Args -> Bool) -> Args -> Bool
forall a b. (a -> b) -> a -> b
$ Args
upd)

boundOfUpdate Args
_ = String -> UpdateBound
forall a. HasCallStack => String -> a
error String
"Expected Update Args!"