{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiWayIf #-}
{-# OPTIONS_HADDOCK ignore-exports #-}

module Hpack.Fields (cmp) where

import Data.Maybe (fromMaybe)
import Data.List (elemIndex)
import Data.String (IsString())
import Control.Applicative (liftA2)
import Data.Foldable (asum)

-- | A default field ordering comparison.
cmp :: (Ord a, IsString a) => a -> a -> Ordering
cmp :: a -> a -> Ordering
cmp a
a a
b =
    Ordering -> Maybe Ordering -> Ordering
forall a. a -> Maybe a -> a
fromMaybe Ordering
fallback
    (Maybe Ordering -> Ordering)
-> ([Maybe Ordering] -> Maybe Ordering)
-> [Maybe Ordering]
-> Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Ordering] -> Maybe Ordering
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    ([Maybe Ordering] -> Ordering) -> [Maybe Ordering] -> Ordering
forall a b. (a -> b) -> a -> b
$ [ (Int -> Int -> Ordering)
-> Maybe Int -> Maybe Int -> Maybe Ordering
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
a [a]
xs) (a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
b [a]
xs) | [a]
xs <- [[a]]
fields ]
    where
        -- NOTE: There can be short form conditions with no then or else. In
        -- that case always put condition before the other field name.
        fallback :: Ordering
fallback =
            if | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"condition" -> Ordering
LT
               | a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"condition" -> Ordering
GT
               | a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
a [a]
forall a. IsString a => [a]
topLevelFields -> Ordering
LT
               | a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
b [a]
forall a. IsString a => [a]
topLevelFields -> Ordering
GT
               | Bool
otherwise -> a
a a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` a
b

        fields :: [[a]]
fields =
            [ [a]
forall a. IsString a => [a]
topLevelFields
            , [a]
forall a. IsString a => [a]
libraryFields [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
forall a. IsString a => [a]
commonFields
            , [a]
forall a. IsString a => [a]
runnableFields [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
forall a. IsString a => [a]
commonFields
            , [a]
forall a. IsString a => [a]
flagFields
            , [a]
forall a. IsString a => [a]
conditionalFields
            , [a]
forall a. IsString a => [a]
defaultsFields
            ]

-- | All <https://github.com/sol/hpack#top-level-fields top-level> fields combined.
topLevelFields :: IsString a => [a]
topLevelFields :: [a]
topLevelFields =
    [a]
forall a. IsString a => [a]
headerFields
    [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
forall a. IsString a => [a]
repoFields
    [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
forall a. IsString a => [a]
packageFields
    [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
forall a. IsString a => [a]
commonFields
    [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
forall a. IsString a => [a]
stanzasFields

-- | The header subset of
-- <https://github.com/sol/hpack#top-level-fields top-level> fields.
headerFields :: IsString a => [a]
headerFields :: [a]
headerFields =
    [ a
"spec-version"
    , a
"name"
    , a
"version"
    , a
"synopsis"
    , a
"description"
    , a
"category"
    , a
"stability"
    , a
"homepage"
    , a
"bug-reports"
    , a
"author"
    , a
"maintainer"
    , a
"copyright"
    , a
"license"
    , a
"license-file"
    , a
"license-files"
    , a
"tested-with"
    , a
"build-type"
    ]

-- | The package subset of
-- <https://github.com/sol/hpack#top-level-fields top-level> fields.
packageFields :: IsString a => [a]
packageFields :: [a]
packageFields =
    [ a
"extra-source-files"
    , a
"extra-doc-files"
    , a
"data-files"
    , a
"data-dir"
    ]

-- | The source repository subset of
-- <https://github.com/sol/hpack#top-level-fields top-level> fields.
repoFields :: IsString a => [a]
repoFields :: [a]
repoFields =
    [ a
"github"
    , a
"git"
    ]

-- | The stanzas subset of
-- <https://github.com/sol/hpack#top-level-fields top-level> fields.
stanzasFields :: IsString a => [a]
stanzasFields :: [a]
stanzasFields =
    [ a
"custom-setup"
    , a
"flags"
    , a
"library"
    , a
"internal-libraries"
    , a
"executables"
    , a
"executable"
    , a
"tests"
    , a
"benchmarks"
    , a
"defaults"
    ]

-- | The <https://github.com/sol/hpack#common-fields common> fields.
commonFields :: IsString a => [a]
commonFields :: [a]
commonFields =
    [ a
"buildable"
    , a
"source-dirs"
    , a
"default-extensions"
    , a
"other-extensions"
    , a
"ghc-options"
    , a
"ghc-prof-options"
    , a
"ghcjs-options"
    , a
"cpp-options"
    , a
"cc-options"
    , a
"c-sources"
    , a
"cxx-options"
    , a
"cxx-sources"
    , a
"js-sources"
    , a
"extra-lib-dirs"
    , a
"extra-libraries"
    , a
"include-dirs"
    , a
"install-includes"
    , a
"frameworks"
    , a
"extra-framework-dirs"
    , a
"ld-options"
    , a
"dependencies"
    , a
"pkg-config-depends"
    , a
"build-tools"
    , a
"system-build-tools"
    , a
"when" -- conditional
    ]


-- | The <https://github.com/sol/hpack#library-fields library> fields.
libraryFields :: IsString a => [a]
libraryFields :: [a]
libraryFields =
    [ a
"exposed"
    , a
"exposed-modules"
    , a
"generated-exposed-modules"
    , a
"other-modules"
    , a
"generated-other-modules"
    , a
"reexported-modules"
    , a
"signatures"
    ]

-- | The <https://github.com/sol/hpack#executable-fields executable>,
-- <https://github.com/sol/hpack#test-fields test> and
-- <https://github.com/sol/hpack#benchmark-fields benchmark> fields are all the
-- same.
runnableFields :: IsString a => [a]
runnableFields :: [a]
runnableFields =
    [ a
"main"
    , a
"other-modules"
    , a
"generated-other-modules"
    ]

-- | The <https://github.com/sol/hpack#flags flag> fields.
flagFields :: IsString a => [a]
flagFields :: [a]
flagFields =
    [ a
"description"
    , a
"manual"
    , a
"default"
    ]

-- | The <https://github.com/sol/hpack#-conditionals conditional> fields.
conditionalFields :: IsString a => [a]
conditionalFields :: [a]
conditionalFields =
    [ a
"condition"
    , a
"then"
    , a
"else"
    ]

-- | The <https://github.com/sol/hpack#defaults defaults> fields.
defaultsFields :: IsString a => [a]
defaultsFields :: [a]
defaultsFields =
    [ a
"github"
    , a
"ref"
    , a
"path"
    , a
"local"
    ]