module CabalGild.Unstable.Action.GetCabalVersion where

import qualified CabalGild.Unstable.Extra.Either as Either
import qualified CabalGild.Unstable.Extra.FieldLine as FieldLine
import qualified CabalGild.Unstable.Extra.Name as Name
import qualified CabalGild.Unstable.Extra.String as String
import qualified Data.List as List
import qualified Data.Maybe as Maybe
import qualified Distribution.CabalSpecVersion as CabalSpecVersion
import qualified Distribution.FieldGrammar.Newtypes as Newtypes
import qualified Distribution.Fields as Fields
import qualified Distribution.Parsec as Parsec

-- | Gets the Cabal spec version from a list of fields. If multiple fields
-- define the version, the first one is used.
fromFields :: [Fields.Field a] -> CabalSpecVersion.CabalSpecVersion
fromFields :: forall a. [Field a] -> CabalSpecVersion
fromFields [Field a]
fs = CabalSpecVersion -> Maybe CabalSpecVersion -> CabalSpecVersion
forall a. a -> Maybe a -> a
Maybe.fromMaybe CabalSpecVersion
CabalSpecVersion.CabalSpecV1_0 (Maybe CabalSpecVersion -> CabalSpecVersion)
-> Maybe CabalSpecVersion -> CabalSpecVersion
forall a b. (a -> b) -> a -> b
$ do
  Field a
f <- (Field a -> Bool) -> [Field a] -> Maybe (Field a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find Field a -> Bool
forall a. Field a -> Bool
isCabalVersion [Field a]
fs
  [FieldLine a]
fls <- Field a -> Maybe [FieldLine a]
forall a. Field a -> Maybe [FieldLine a]
getFieldLines Field a
f
  SpecVersion -> CabalSpecVersion
Newtypes.getSpecVersion (SpecVersion -> CabalSpecVersion)
-> Maybe SpecVersion -> Maybe CabalSpecVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldLine a] -> Maybe SpecVersion
forall a. [FieldLine a] -> Maybe SpecVersion
fromFieldLines [FieldLine a]
fls

-- | Returns true if the field is named @cabal-version@.
isCabalVersion :: Fields.Field a -> Bool
isCabalVersion :: forall a. Field a -> Bool
isCabalVersion Field a
f = case Field a
f of
  Fields.Field Name a
n [FieldLine a]
_ -> Name a -> FieldName
forall a. Name a -> FieldName
Name.value Name a
n FieldName -> FieldName -> Bool
forall a. Eq a => a -> a -> Bool
== String -> FieldName
String.toUtf8 String
"cabal-version"
  Fields.Section {} -> Bool
False

-- | Gets the field lines from a field. If the field is a section, this returns
-- 'Nothing'.
getFieldLines :: Fields.Field a -> Maybe [Fields.FieldLine a]
getFieldLines :: forall a. Field a -> Maybe [FieldLine a]
getFieldLines Field a
f = case Field a
f of
  Fields.Field Name a
_ [FieldLine a]
fls -> [FieldLine a] -> Maybe [FieldLine a]
forall a. a -> Maybe a
Just [FieldLine a]
fls
  Fields.Section {} -> Maybe [FieldLine a]
forall a. Maybe a
Nothing

-- | Attempts to parse the given field lines as a Cabal spec version.
fromFieldLines :: [Fields.FieldLine a] -> Maybe Newtypes.SpecVersion
fromFieldLines :: forall a. [FieldLine a] -> Maybe SpecVersion
fromFieldLines =
  Either ParseError SpecVersion -> Maybe SpecVersion
forall x a. Either x a -> Maybe a
Either.hush
    (Either ParseError SpecVersion -> Maybe SpecVersion)
-> ([FieldLine a] -> Either ParseError SpecVersion)
-> [FieldLine a]
-> Maybe SpecVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecParser SpecVersion
-> String -> FieldLineStream -> Either ParseError SpecVersion
forall a.
ParsecParser a -> String -> FieldLineStream -> Either ParseError a
Parsec.runParsecParser ParsecParser SpecVersion
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m SpecVersion
Parsec.parsec String
""
    (FieldLineStream -> Either ParseError SpecVersion)
-> ([FieldLine a] -> FieldLineStream)
-> [FieldLine a]
-> Either ParseError SpecVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FieldLine a] -> FieldLineStream
forall a. [FieldLine a] -> FieldLineStream
FieldLine.toFieldLineStream