-- Helpers to generate steps using tools: hlint and doctest
module HaskellCI.Tools (
    -- * Doctest
    doctestJobVersionRange,
    doctestArgs,
    -- * HLint
    hlintJobVersionRange,
    hlintArgs,
    ) where

import HaskellCI.Prelude

import qualified Data.Set                                      as S
import qualified Distribution.PackageDescription               as C
import qualified Distribution.PackageDescription.Configuration as C
import qualified Distribution.Pretty                           as C
import qualified Distribution.Types.VersionRange               as C
import qualified Distribution.Utils.Path                       as C
import qualified Distribution.Version                          as C

import qualified Distribution.Types.BuildInfo.Lens          as L
import qualified Distribution.Types.PackageDescription.Lens as L

import HaskellCI.Compiler
import HaskellCI.Config.HLint

-------------------------------------------------------------------------------
-- Doctest
-------------------------------------------------------------------------------

doctestJobVersionRange :: CompilerRange
doctestJobVersionRange :: CompilerRange
doctestJobVersionRange = CompilerRange
RangeGHC CompilerRange -> CompilerRange -> CompilerRange
forall a. Lattice a => a -> a -> a
/\ VersionRange -> CompilerRange
Range (Version -> VersionRange
C.orLaterVersion (Version -> VersionRange) -> Version -> VersionRange
forall a b. (a -> b) -> a -> b
$ [Int] -> Version
C.mkVersion [Int
8,Int
0])

-- | Modules arguments to the library
--
-- * We check the library component
--
-- * If there are hs-source-dirs, use them
--
-- * otherwise use exposed + other modules
--
-- * Also add default-extensions
--
-- /Note:/ same argument work for hlint too, but not exactly
--
doctestArgs :: C.GenericPackageDescription -> [[String]]
doctestArgs :: GenericPackageDescription -> [[String]]
doctestArgs GenericPackageDescription
gpd = [[String]] -> [[String]]
forall a. Eq a => [a] -> [a]
nub ([[String]] -> [[String]]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> a -> b
$
    [ Library -> [String]
libraryModuleArgs Library
c
    | Library
c <- Getting (DList Library) PackageDescription Library
-> PackageDescription -> [Library]
forall a s. Getting (DList a) s a -> s -> [a]
toListOf (LensLike
  (Const (DList Library))
  PackageDescription
  PackageDescription
  (Maybe Library)
  (Maybe Library)
Lens' PackageDescription (Maybe Library)
L.library LensLike
  (Const (DList Library))
  PackageDescription
  PackageDescription
  (Maybe Library)
  (Maybe Library)
-> ((Library -> Const (DList Library) Library)
    -> Maybe Library -> Const (DList Library) (Maybe Library))
-> Getting (DList Library) PackageDescription Library
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Library -> Const (DList Library) Library)
-> Maybe Library -> Const (DList Library) (Maybe Library)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse) (GenericPackageDescription -> PackageDescription
C.flattenPackageDescription GenericPackageDescription
gpd)
    ] [[String]] -> [[String]] -> [[String]]
forall a. [a] -> [a] -> [a]
++
    [ Library -> [String]
libraryModuleArgs Library
c
    | Library
c <- Getting (DList Library) PackageDescription Library
-> PackageDescription -> [Library]
forall a s. Getting (DList a) s a -> s -> [a]
toListOf (LensLike
  (Const (DList Library))
  PackageDescription
  PackageDescription
  [Library]
  [Library]
Lens' PackageDescription [Library]
L.subLibraries LensLike
  (Const (DList Library))
  PackageDescription
  PackageDescription
  [Library]
  [Library]
-> ((Library -> Const (DList Library) Library)
    -> [Library] -> Const (DList Library) [Library])
-> Getting (DList Library) PackageDescription Library
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Library -> Const (DList Library) Library)
-> [Library] -> Const (DList Library) [Library]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse) (GenericPackageDescription -> PackageDescription
C.flattenPackageDescription GenericPackageDescription
gpd)
    ]

libraryModuleArgs :: C.Library -> [String]
libraryModuleArgs :: Library -> [String]
libraryModuleArgs Library
l
    | [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
dirsOrMods = []
    | Bool
otherwise       = [String]
lang [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
exts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
dirsOrMods
  where
    bi :: BuildInfo
bi = Library
l Library -> Getting BuildInfo Library BuildInfo -> BuildInfo
forall s a. s -> Getting a s a -> a
^. Getting BuildInfo Library BuildInfo
forall a. HasBuildInfo a => Lens' a BuildInfo
Lens' Library BuildInfo
L.buildInfo

    dirsOrMods :: [String]
dirsOrMods
        | [SymbolicPath PackageDir SourceDir] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [SymbolicPath PackageDir SourceDir]
C.hsSourceDirs BuildInfo
bi) = (ModuleName -> String) -> [ModuleName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
forall a. Pretty a => a -> String
C.prettyShow (Library -> [ModuleName]
C.exposedModules Library
l)
        | Bool
otherwise                = (SymbolicPath PackageDir SourceDir -> String)
-> [SymbolicPath PackageDir SourceDir] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> String
forall from to. SymbolicPath from to -> String
C.getSymbolicPath ([SymbolicPath PackageDir SourceDir] -> [String])
-> [SymbolicPath PackageDir SourceDir] -> [String]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [SymbolicPath PackageDir SourceDir]
C.hsSourceDirs BuildInfo
bi

    lang :: [String]
lang = [String] -> (Language -> [String]) -> Maybe Language -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (String -> [String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String])
-> (Language -> String) -> Language -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"-X" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Language -> String) -> Language -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Language -> String
forall a. Pretty a => a -> String
C.prettyShow) (BuildInfo -> Maybe Language
C.defaultLanguage BuildInfo
bi)

    exts :: [String]
exts = (Extension -> String) -> [Extension] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String
"-X" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Extension -> String) -> Extension -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> String
forall a. Pretty a => a -> String
C.prettyShow) (BuildInfo -> [Extension]
C.defaultExtensions BuildInfo
bi)

executableModuleArgs :: C.Executable -> [String]
executableModuleArgs :: Executable -> [String]
executableModuleArgs Executable
e
    | [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
dirsOrMods = []
    | Bool
otherwise       = [String]
lang [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
exts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
dirsOrMods
  where
    bi :: BuildInfo
bi = Executable
e Executable -> Getting BuildInfo Executable BuildInfo -> BuildInfo
forall s a. s -> Getting a s a -> a
^. Getting BuildInfo Executable BuildInfo
forall a. HasBuildInfo a => Lens' a BuildInfo
Lens' Executable BuildInfo
L.buildInfo

    dirsOrMods :: [String]
dirsOrMods
        -- note: we don't try to find main_is location, if hsSourceDirs is empty.
        | [SymbolicPath PackageDir SourceDir] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [SymbolicPath PackageDir SourceDir]
C.hsSourceDirs BuildInfo
bi) = (ModuleName -> String) -> [ModuleName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
forall a. Pretty a => a -> String
C.prettyShow (BuildInfo -> [ModuleName]
C.otherModules BuildInfo
bi)
        | Bool
otherwise                = (SymbolicPath PackageDir SourceDir -> String)
-> [SymbolicPath PackageDir SourceDir] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> String
forall from to. SymbolicPath from to -> String
C.getSymbolicPath ([SymbolicPath PackageDir SourceDir] -> [String])
-> [SymbolicPath PackageDir SourceDir] -> [String]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [SymbolicPath PackageDir SourceDir]
C.hsSourceDirs BuildInfo
bi

    lang :: [String]
lang = [String] -> (Language -> [String]) -> Maybe Language -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (String -> [String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String])
-> (Language -> String) -> Language -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"-X" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Language -> String) -> Language -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Language -> String
forall a. Pretty a => a -> String
C.prettyShow) (BuildInfo -> Maybe Language
C.defaultLanguage BuildInfo
bi)

    exts :: [String]
exts = (Extension -> String) -> [Extension] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String
"-X" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Extension -> String) -> Extension -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> String
forall a. Pretty a => a -> String
C.prettyShow) (BuildInfo -> [Extension]
C.defaultExtensions BuildInfo
bi)

-------------------------------------------------------------------------------
-- HLint
-------------------------------------------------------------------------------

hlintJobVersionRange
    :: Set CompilerVersion  -- ^ all compilers
    -> VersionRange         -- ^ head.hackage
    -> HLintJob             -- ^ hlint-jobs
    -> CompilerRange
hlintJobVersionRange :: Set CompilerVersion -> VersionRange -> HLintJob -> CompilerRange
hlintJobVersionRange Set CompilerVersion
vs VersionRange
headHackage HLintJob
HLintJobLatest = case Set Version -> Maybe (Version, Set Version)
forall a. Set a -> Maybe (a, Set a)
S.maxView Set Version
vs' of
    Just (Version
v, Set Version
_) -> Set CompilerVersion -> CompilerRange
RangePoints (CompilerVersion -> Set CompilerVersion
forall a. a -> Set a
S.singleton (Version -> CompilerVersion
GHC Version
v))
    Maybe (Version, Set Version)
_           -> Set CompilerVersion -> CompilerRange
RangePoints Set CompilerVersion
forall a. Set a
S.empty
  where
    -- remove non GHC versions, and head.hackage versions
    vs' :: Set Version
vs' = [Version] -> Set Version
forall a. Ord a => [a] -> Set a
S.fromList
        ([Version] -> Set Version) -> [Version] -> Set Version
forall a b. (a -> b) -> a -> b
$ (Version -> Bool) -> [Version] -> [Version]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Version
v -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Version -> VersionRange -> Bool
C.withinRange Version
v VersionRange
headHackage)
        ([Version] -> [Version]) -> [Version] -> [Version]
forall a b. (a -> b) -> a -> b
$ (CompilerVersion -> Maybe Version)
-> [CompilerVersion] -> [Version]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Maybe Version
-> (Version -> Maybe Version) -> CompilerVersion -> Maybe Version
forall a. a -> (Version -> a) -> CompilerVersion -> a
maybeGHC Maybe Version
forall a. Maybe a
Nothing Version -> Maybe Version
forall a. a -> Maybe a
Just)
        ([CompilerVersion] -> [Version]) -> [CompilerVersion] -> [Version]
forall a b. (a -> b) -> a -> b
$ Set CompilerVersion -> [CompilerVersion]
forall a. Set a -> [a]
S.toList Set CompilerVersion
vs

hlintJobVersionRange Set CompilerVersion
_ VersionRange
_ (HLintJob Version
v)   = Set CompilerVersion -> CompilerRange
RangePoints (CompilerVersion -> Set CompilerVersion
forall a. a -> Set a
S.singleton (Version -> CompilerVersion
GHC Version
v))

hlintArgs :: C.GenericPackageDescription -> [[String]]
hlintArgs :: GenericPackageDescription -> [[String]]
hlintArgs GenericPackageDescription
gpd = [[String]] -> [[String]]
forall a. Eq a => [a] -> [a]
nub ([[String]] -> [[String]]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> a -> b
$
    [ Library -> [String]
libraryModuleArgs Library
c
    | Library
c <- Getting (DList Library) PackageDescription Library
-> PackageDescription -> [Library]
forall a s. Getting (DList a) s a -> s -> [a]
toListOf (LensLike
  (Const (DList Library))
  PackageDescription
  PackageDescription
  (Maybe Library)
  (Maybe Library)
Lens' PackageDescription (Maybe Library)
L.library LensLike
  (Const (DList Library))
  PackageDescription
  PackageDescription
  (Maybe Library)
  (Maybe Library)
-> ((Library -> Const (DList Library) Library)
    -> Maybe Library -> Const (DList Library) (Maybe Library))
-> Getting (DList Library) PackageDescription Library
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Library -> Const (DList Library) Library)
-> Maybe Library -> Const (DList Library) (Maybe Library)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse) (GenericPackageDescription -> PackageDescription
C.flattenPackageDescription GenericPackageDescription
gpd)
    ] [[String]] -> [[String]] -> [[String]]
forall a. [a] -> [a] -> [a]
++
    [ Library -> [String]
libraryModuleArgs Library
c
    | Library
c <- Getting (DList Library) PackageDescription Library
-> PackageDescription -> [Library]
forall a s. Getting (DList a) s a -> s -> [a]
toListOf (LensLike
  (Const (DList Library))
  PackageDescription
  PackageDescription
  [Library]
  [Library]
Lens' PackageDescription [Library]
L.subLibraries LensLike
  (Const (DList Library))
  PackageDescription
  PackageDescription
  [Library]
  [Library]
-> ((Library -> Const (DList Library) Library)
    -> [Library] -> Const (DList Library) [Library])
-> Getting (DList Library) PackageDescription Library
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Library -> Const (DList Library) Library)
-> [Library] -> Const (DList Library) [Library]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse) (GenericPackageDescription -> PackageDescription
C.flattenPackageDescription GenericPackageDescription
gpd)
    ] [[String]] -> [[String]] -> [[String]]
forall a. [a] -> [a] -> [a]
++
    [ Executable -> [String]
executableModuleArgs Executable
c
    | Executable
c <- Getting (DList Executable) PackageDescription Executable
-> PackageDescription -> [Executable]
forall a s. Getting (DList a) s a -> s -> [a]
toListOf (LensLike
  (Const (DList Executable))
  PackageDescription
  PackageDescription
  [Executable]
  [Executable]
Lens' PackageDescription [Executable]
L.executables LensLike
  (Const (DList Executable))
  PackageDescription
  PackageDescription
  [Executable]
  [Executable]
-> ((Executable -> Const (DList Executable) Executable)
    -> [Executable] -> Const (DList Executable) [Executable])
-> Getting (DList Executable) PackageDescription Executable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Executable -> Const (DList Executable) Executable)
-> [Executable] -> Const (DList Executable) [Executable]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse) (GenericPackageDescription -> PackageDescription
C.flattenPackageDescription GenericPackageDescription
gpd)
    ]