module Elm.Package.Constraint
    ( Constraint
    , fromString
    , toString
    , untilNextMajor
    , untilNextMinor
    , expand
    , defaultElmVersion
    , isSatisfied
    , check
    , errorMessage
    ) where

import qualified Data.Aeson as Json
import qualified Data.Text as Text

import qualified Elm.Package as Package
import qualified Elm.Compiler as Compiler



-- CONSTRAINTS


data Constraint
    = Range Package.Version Op Op Package.Version


data Op = Less | LessOrEqual



-- CREATE CONSTRAINTS


untilNextMajor :: Package.Version -> Constraint
untilNextMajor version =
  Range version LessOrEqual Less (Package.bumpMajor version)


untilNextMinor :: Package.Version -> Constraint
untilNextMinor version =
  Range version LessOrEqual Less (Package.bumpMinor version)


expand :: Constraint -> Package.Version -> Constraint
expand constraint@(Range lower lowerOp upperOp upper) version
  | version < lower =
      Range version LessOrEqual upperOp upper

  | version > upper =
      Range lower lowerOp Less (Package.bumpMajor version)

  | otherwise =
      constraint



  ELM CONSTRAINT


defaultElmVersion :: Constraint
defaultElmVersion =
  if Package._major Compiler.version > 0
    then untilNextMajor Compiler.version
    else untilNextMinor Compiler.version



-- CHECK IF SATISFIED


isSatisfied :: Constraint -> Package.Version -> Bool
isSatisfied constraint version =
  case constraint of
    Range lower lowerOp upperOp upper ->
        isLess lowerOp lower version
          &&
        isLess upperOp version upper


isLess :: (Ord a) => Op -> (a -> a -> Bool)
isLess op =
  case op of
    Less ->
      (<)

    LessOrEqual ->
      (<=)


check :: Constraint -> Package.Version -> Ordering
check constraint version =
  case constraint of
    Range lower lowerOp upperOp upper ->
      if not (isLess lowerOp lower version) then
        LT

      else if not (isLess upperOp version upper) then
        GT

      else
        EQ



-- STRING CONVERSION


toString :: Constraint -> String
toString constraint =
  case constraint of
    Range lower lowerOp upperOp upper ->
      unwords
        [ Package.versionToString lower
        , opToString lowerOp
        , "v"
        , opToString upperOp
        , Package.versionToString upper
        ]


opToString :: Op -> String
opToString op =
  case op of
    Less -> "<"
    LessOrEqual -> "<="


fromString :: String -> Maybe Constraint
fromString str =
  do  let (lowerString, rest) = break (==' ') str
      lower <- versionFromString lowerString
      (lowerOp, rest1) <- takeOp (eatSpace rest)
      rest2 <- eatV (eatSpace rest1)
      (upperOp, rest3) <- takeOp (eatSpace rest2)
      upper <- versionFromString (eatSpace rest3)
      return (Range lower lowerOp upperOp upper)


eatSpace :: String -> String
eatSpace str =
  case str of
    ' ' : rest -> rest
    _ -> str


versionFromString :: String -> Maybe Package.Version
versionFromString =
    either (const Nothing) Just . Package.versionFromString


takeOp :: String -> Maybe (Op, String)
takeOp str =
  case str of
    '<' : '=' : rest -> Just (LessOrEqual, rest)
    '<' : rest -> Just (Less, rest)
    _ -> Nothing


eatV :: String -> Maybe String
eatV str =
  case str of
    'v' : rest -> Just rest
    _ -> Nothing




-- JSON CONVERSION


instance Json.ToJSON Constraint where
    toJSON constraint =
        Json.toJSON (toString constraint)


instance Json.FromJSON Constraint where
    parseJSON (Json.String text) =
        let rawConstraint = Text.unpack text in
        case fromString rawConstraint of
          Just constraint ->
              return constraint

          Nothing ->
              fail $ errorMessage Nothing rawConstraint

    parseJSON _ =
        fail "constraint must be a string that looks something like \"1.2.1 <= v < 2.0.0\"."


errorMessage :: Maybe String -> String -> String
errorMessage maybeContext rawConstraint =
  unlines
    [ "Ran into invalid constraint \"" ++ rawConstraint ++ "\"" ++ maybe "" (" for " ++) maybeContext
    , ""
    , "It should look something like \"1.2.1 <= v < 2.0.0\", with no extra or missing"
    , "spaces. The middle letter needs to be a 'v' as well."
    , ""
    , "Upper and lower bounds are required so that bounds represent the maximum range"
    , "known to work. You do not want to promise users your library will work with"
    , "4.0.0 that version has not been tested!"
    ]
 CONSTRAINTS
 CREATE CONSTRAINTS
 CHECK IF SATISFIED
 STRING CONVERSION
 JSON CONVERSION
module Elm.Package.Constraint
    ( Constraint
    , fromString
    , toString
    , untilNextMajor
    , untilNextMinor
    , expand
    , defaultElmVersion
    , isSatisfied
    , check
    , errorMessage
    ) where

import qualified Data.Aeson as Json
import qualified Data.Text as Text

import qualified Elm.Package as Package
import qualified Elm.Compiler as Compiler





data Constraint
    = Range Package.Version Op Op Package.Version


data Op = Less | LessOrEqual





untilNextMajor :: Package.Version -> Constraint
untilNextMajor version =
  Range version LessOrEqual Less (Package.bumpMajor version)


untilNextMinor :: Package.Version -> Constraint
untilNextMinor version =
  Range version LessOrEqual Less (Package.bumpMinor version)


expand :: Constraint -> Package.Version -> Constraint
expand constraint@(Range lower lowerOp upperOp upper) version
  | version < lower =
      Range version LessOrEqual upperOp upper

  | version > upper =
      Range lower lowerOp Less (Package.bumpMajor version)

  | otherwise =
      constraint



  ELM CONSTRAINT


defaultElmVersion :: Constraint
defaultElmVersion =
  if Package._major Compiler.version > 0
    then untilNextMajor Compiler.version
    else untilNextMinor Compiler.version





isSatisfied :: Constraint -> Package.Version -> Bool
isSatisfied constraint version =
  case constraint of
    Range lower lowerOp upperOp upper ->
        isLess lowerOp lower version
          &&
        isLess upperOp version upper


isLess :: (Ord a) => Op -> (a -> a -> Bool)
isLess op =
  case op of
    Less ->
      (<)

    LessOrEqual ->
      (<=)


check :: Constraint -> Package.Version -> Ordering
check constraint version =
  case constraint of
    Range lower lowerOp upperOp upper ->
      if not (isLess lowerOp lower version) then
        LT

      else if not (isLess upperOp version upper) then
        GT

      else
        EQ





toString :: Constraint -> String
toString constraint =
  case constraint of
    Range lower lowerOp upperOp upper ->
      unwords
        [ Package.versionToString lower
        , opToString lowerOp
        , "v"
        , opToString upperOp
        , Package.versionToString upper
        ]


opToString :: Op -> String
opToString op =
  case op of
    Less -> "<"
    LessOrEqual -> "<="


fromString :: String -> Maybe Constraint
fromString str =
  do  let (lowerString, rest) = break (==' ') str
      lower <- versionFromString lowerString
      (lowerOp, rest1) <- takeOp (eatSpace rest)
      rest2 <- eatV (eatSpace rest1)
      (upperOp, rest3) <- takeOp (eatSpace rest2)
      upper <- versionFromString (eatSpace rest3)
      return (Range lower lowerOp upperOp upper)


eatSpace :: String -> String
eatSpace str =
  case str of
    ' ' : rest -> rest
    _ -> str


versionFromString :: String -> Maybe Package.Version
versionFromString =
    either (const Nothing) Just . Package.versionFromString


takeOp :: String -> Maybe (Op, String)
takeOp str =
  case str of
    '<' : '=' : rest -> Just (LessOrEqual, rest)
    '<' : rest -> Just (Less, rest)
    _ -> Nothing


eatV :: String -> Maybe String
eatV str =
  case str of
    'v' : rest -> Just rest
    _ -> Nothing






instance Json.ToJSON Constraint where
    toJSON constraint =
        Json.toJSON (toString constraint)


instance Json.FromJSON Constraint where
    parseJSON (Json.String text) =
        let rawConstraint = Text.unpack text in
        case fromString rawConstraint of
          Just constraint ->
              return constraint

          Nothing ->
              fail $ errorMessage Nothing rawConstraint

    parseJSON _ =
        fail "constraint must be a string that looks something like \"1.2.1 <= v < 2.0.0\"."


errorMessage :: Maybe String -> String -> String
errorMessage maybeContext rawConstraint =
  unlines
    [ "Ran into invalid constraint \"" ++ rawConstraint ++ "\"" ++ maybe "" (" for " ++) maybeContext
    , ""
    , "It should look something like \"1.2.1 <= v < 2.0.0\", with no extra or missing"
    , "spaces. The middle letter needs to be a 'v' as well."
    , ""
    , "Upper and lower bounds are required so that bounds represent the maximum range"
    , "known to work. You do not want to promise users your library will work with"
    , "4.0.0 that version has not been tested!"
    ]