{-# LANGUAGE Rank2Types, PatternGuards, TupleSections #-}

module CabalCargs.BuildInfo
   ( field
   ) where

import Distribution.PackageDescription (BuildInfo(..))
import Distribution.Compiler (PerCompilerFlavor(..))
import Control.Lens
import qualified CabalCargs.Fields as F
import qualified CabalLenses as CL
import Language.Haskell.Extension (Extension(..), KnownExtension(..), Language(..))


-- | A lens from a 'BuildInfo' to a list of stringified field entries of the 'BuildInfo'.
field :: F.Field -> Traversal' BuildInfo [String]
field :: Field -> Traversal' BuildInfo [String]
field Field
F.Hs_Source_Dirs         = ([SymbolicPath Pkg ('Dir Source)]
 -> f [SymbolicPath Pkg ('Dir Source)])
-> BuildInfo -> f BuildInfo
Lens' BuildInfo [SymbolicPath Pkg ('Dir Source)]
CL.hsSourceDirsL (([SymbolicPath Pkg ('Dir Source)]
  -> f [SymbolicPath Pkg ('Dir Source)])
 -> BuildInfo -> f BuildInfo)
-> (([String] -> f [String])
    -> [SymbolicPath Pkg ('Dir Source)]
    -> f [SymbolicPath Pkg ('Dir Source)])
-> ([String] -> f [String])
-> BuildInfo
-> f BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> f [String])
-> [SymbolicPath Pkg ('Dir Source)]
-> f [SymbolicPath Pkg ('Dir Source)]
forall from (to :: FileOrDir) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p [String] (f [String])
-> p [SymbolicPath from to] (f [SymbolicPath from to])
CL.symPathsToFilePaths
field Field
F.Ghc_Options            = (PerCompilerFlavor [String] -> f (PerCompilerFlavor [String]))
-> BuildInfo -> f BuildInfo
Lens' BuildInfo (PerCompilerFlavor [String])
CL.optionsL ((PerCompilerFlavor [String] -> f (PerCompilerFlavor [String]))
 -> BuildInfo -> f BuildInfo)
-> (([String] -> f [String])
    -> PerCompilerFlavor [String] -> f (PerCompilerFlavor [String]))
-> ([String] -> f [String])
-> BuildInfo
-> f BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> f [String])
-> PerCompilerFlavor [String] -> f (PerCompilerFlavor [String])
Lens' (PerCompilerFlavor [String]) [String]
ghcOptionsL
field Field
F.Default_Extensions     = ([Extension] -> f [Extension]) -> BuildInfo -> f BuildInfo
Lens' BuildInfo [Extension]
oldAndDefaultExtensionsL (([Extension] -> f [Extension]) -> BuildInfo -> f BuildInfo)
-> (([String] -> f [String]) -> [Extension] -> f [Extension])
-> ([String] -> f [String])
-> BuildInfo
-> f BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> f [String]) -> [Extension] -> f [Extension]
Iso' [Extension] [String]
extsToStrings
field Field
F.Default_Language       = (Maybe Language -> f (Maybe Language)) -> BuildInfo -> f BuildInfo
Lens' BuildInfo (Maybe Language)
CL.defaultLanguageL ((Maybe Language -> f (Maybe Language))
 -> BuildInfo -> f BuildInfo)
-> (([String] -> f [String])
    -> Maybe Language -> f (Maybe Language))
-> ([String] -> f [String])
-> BuildInfo
-> f BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> f [String]) -> Maybe Language -> f (Maybe Language)
Iso' (Maybe Language) [String]
langToString
field Field
F.Cpp_Options            = ([String] -> f [String]) -> BuildInfo -> f BuildInfo
Lens' BuildInfo [String]
CL.cppOptionsL
field Field
F.C_Sources              = ([SymbolicPath Pkg 'File] -> f [SymbolicPath Pkg 'File])
-> BuildInfo -> f BuildInfo
Lens' BuildInfo [SymbolicPath Pkg 'File]
CL.cSourcesL (([SymbolicPath Pkg 'File] -> f [SymbolicPath Pkg 'File])
 -> BuildInfo -> f BuildInfo)
-> (([String] -> f [String])
    -> [SymbolicPath Pkg 'File] -> f [SymbolicPath Pkg 'File])
-> ([String] -> f [String])
-> BuildInfo
-> f BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> f [String])
-> [SymbolicPath Pkg 'File] -> f [SymbolicPath Pkg 'File]
forall from (to :: FileOrDir) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p [String] (f [String])
-> p [SymbolicPath from to] (f [SymbolicPath from to])
CL.symPathsToFilePaths
field Field
F.Cc_Options             = ([String] -> f [String]) -> BuildInfo -> f BuildInfo
Lens' BuildInfo [String]
CL.ccOptionsL
field Field
F.Extra_Lib_Dirs         = ([SymbolicPath Pkg ('Dir Lib)] -> f [SymbolicPath Pkg ('Dir Lib)])
-> BuildInfo -> f BuildInfo
Lens' BuildInfo [SymbolicPath Pkg ('Dir Lib)]
CL.extraLibDirsL (([SymbolicPath Pkg ('Dir Lib)] -> f [SymbolicPath Pkg ('Dir Lib)])
 -> BuildInfo -> f BuildInfo)
-> (([String] -> f [String])
    -> [SymbolicPath Pkg ('Dir Lib)]
    -> f [SymbolicPath Pkg ('Dir Lib)])
-> ([String] -> f [String])
-> BuildInfo
-> f BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> f [String])
-> [SymbolicPath Pkg ('Dir Lib)] -> f [SymbolicPath Pkg ('Dir Lib)]
forall from (to :: FileOrDir) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p [String] (f [String])
-> p [SymbolicPath from to] (f [SymbolicPath from to])
CL.symPathsToFilePaths
field Field
F.Extra_Libraries        = ([String] -> f [String]) -> BuildInfo -> f BuildInfo
Lens' BuildInfo [String]
CL.extraLibsL
field Field
F.Ld_Options             = ([String] -> f [String]) -> BuildInfo -> f BuildInfo
Lens' BuildInfo [String]
CL.ldOptionsL
field Field
F.Include_Dirs           = ([SymbolicPath Pkg ('Dir Include)]
 -> f [SymbolicPath Pkg ('Dir Include)])
-> BuildInfo -> f BuildInfo
Lens' BuildInfo [SymbolicPath Pkg ('Dir Include)]
CL.includeDirsL (([SymbolicPath Pkg ('Dir Include)]
  -> f [SymbolicPath Pkg ('Dir Include)])
 -> BuildInfo -> f BuildInfo)
-> (([String] -> f [String])
    -> [SymbolicPath Pkg ('Dir Include)]
    -> f [SymbolicPath Pkg ('Dir Include)])
-> ([String] -> f [String])
-> BuildInfo
-> f BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> f [String])
-> [SymbolicPath Pkg ('Dir Include)]
-> f [SymbolicPath Pkg ('Dir Include)]
forall from (to :: FileOrDir) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p [String] (f [String])
-> p [SymbolicPath from to] (f [SymbolicPath from to])
CL.symPathsToFilePaths
field Field
F.Includes               = ([SymbolicPath Include 'File] -> f [SymbolicPath Include 'File])
-> BuildInfo -> f BuildInfo
Lens' BuildInfo [SymbolicPath Include 'File]
CL.includesL (([SymbolicPath Include 'File] -> f [SymbolicPath Include 'File])
 -> BuildInfo -> f BuildInfo)
-> (([String] -> f [String])
    -> [SymbolicPath Include 'File] -> f [SymbolicPath Include 'File])
-> ([String] -> f [String])
-> BuildInfo
-> f BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> f [String])
-> [SymbolicPath Include 'File] -> f [SymbolicPath Include 'File]
forall from (to :: FileOrDir) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p [String] (f [String])
-> p [SymbolicPath from to] (f [SymbolicPath from to])
CL.symPathsToFilePaths
field Field
F.Build_Depends          = ([String] -> f [String]) -> BuildInfo -> f BuildInfo
Lens' BuildInfo [String]
nopLens
field Field
F.Package_Db             = ([String] -> f [String]) -> BuildInfo -> f BuildInfo
Lens' BuildInfo [String]
nopLens
field Field
F.Root_Dir               = ([String] -> f [String]) -> BuildInfo -> f BuildInfo
Lens' BuildInfo [String]
nopLens
field Field
F.Autogen_Hs_Source_Dirs = ([String] -> f [String]) -> BuildInfo -> f BuildInfo
Lens' BuildInfo [String]
nopLens
field Field
F.Autogen_Include_Dirs   = ([String] -> f [String]) -> BuildInfo -> f BuildInfo
Lens' BuildInfo [String]
nopLens
field Field
F.Autogen_Includes       = ([String] -> f [String]) -> BuildInfo -> f BuildInfo
Lens' BuildInfo [String]
nopLens
field Field
F.Hdevtools_Socket       = ([String] -> f [String]) -> BuildInfo -> f BuildInfo
Lens' BuildInfo [String]
nopLens


-- | A lens that merges the fields 'default-extensions' and 'extensions',
--   which now mean the same thing in cabal, 'extensions' is only the old
--   name of 'default-extensions'.
oldAndDefaultExtensionsL :: Lens' BuildInfo [Extension]
oldAndDefaultExtensionsL :: Lens' BuildInfo [Extension]
oldAndDefaultExtensionsL = (BuildInfo -> [Extension])
-> (BuildInfo -> [Extension] -> BuildInfo)
-> Lens' BuildInfo [Extension]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BuildInfo -> [Extension]
getter BuildInfo -> [Extension] -> BuildInfo
setter
   where
      getter :: BuildInfo -> [Extension]
getter BuildInfo
buildInfo      = BuildInfo -> [Extension]
oldExtensions BuildInfo
buildInfo [Extension] -> [Extension] -> [Extension]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [Extension]
defaultExtensions BuildInfo
buildInfo
      setter :: BuildInfo -> [Extension] -> BuildInfo
setter BuildInfo
buildInfo [Extension]
exts = BuildInfo
buildInfo { defaultExtensions = exts }


-- | An iso that converts between a list of extensions
--   and a list of strings containing the names of the extensions.
extsToStrings :: Iso' [Extension] [String]
extsToStrings :: Iso' [Extension] [String]
extsToStrings = ([Extension] -> [String])
-> ([String] -> [Extension]) -> Iso' [Extension] [String]
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ((Extension -> String) -> [Extension] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Extension -> String
toString) ((String -> Extension) -> [String] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map String -> Extension
toExt)
   where
      toString :: Extension -> String
toString Extension
ext =
         case Extension
ext of
              EnableExtension KnownExtension
knownExt    -> KnownExtension -> String
forall a. Show a => a -> String
show KnownExtension
knownExt
              DisableExtension KnownExtension
knownExt   -> String
"No" String -> String -> String
forall a. [a] -> [a] -> [a]
++ KnownExtension -> String
forall a. Show a => a -> String
show KnownExtension
knownExt
              UnknownExtension String
unknownExt -> String
unknownExt

      toExt :: String -> Extension
toExt (Char
'N':Char
'o':String
rest)
         | [(KnownExtension
ext, String
_)] <- ReadS KnownExtension
forall a. Read a => ReadS a
reads String
rest :: [(KnownExtension, String)]
         = KnownExtension -> Extension
DisableExtension KnownExtension
ext

      toExt String
str
         | [(KnownExtension
ext, String
_)] <- ReadS KnownExtension
forall a. Read a => ReadS a
reads String
str :: [(KnownExtension, String)]
         = KnownExtension -> Extension
EnableExtension KnownExtension
ext

         | Bool
otherwise
         = String -> Extension
UnknownExtension String
str


-- | An iso that converts between the language and
--   a list containing a string with the name of the language.
langToString :: Iso' (Maybe Language) [String]
langToString :: Iso' (Maybe Language) [String]
langToString = (Maybe Language -> [String])
-> ([String] -> Maybe Language) -> Iso' (Maybe Language) [String]
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Maybe Language -> [String]
toString [String] -> Maybe Language
toLang
   where
      toString :: Maybe Language -> [String]
toString Maybe Language
Nothing     = []
      toString (Just Language
lang) =
         case Language
lang of
              UnknownLanguage String
l -> [String
l]
              Language
_                 -> [Language -> String
forall a. Show a => a -> String
show Language
lang]

      toLang :: [String] -> Maybe Language
toLang (String
str:[])
         | [(Language
lang, String
_)] <- ReadS Language
forall a. Read a => ReadS a
reads String
str :: [(Language, String)]
         = Language -> Maybe Language
forall a. a -> Maybe a
Just Language
lang

         | Bool
otherwise
         = Language -> Maybe Language
forall a. a -> Maybe a
Just (Language -> Maybe Language) -> Language -> Maybe Language
forall a b. (a -> b) -> a -> b
$ String -> Language
UnknownLanguage String
str

      toLang [String]
_ = Maybe Language
forall a. Maybe a
Nothing


-- | A lens that does nothing, always returns an empty
--   list and doesn't modify the given BuildInfo.
nopLens :: Lens' BuildInfo [String]
nopLens :: Lens' BuildInfo [String]
nopLens = (BuildInfo -> [String])
-> (BuildInfo -> [String] -> BuildInfo) -> Lens' BuildInfo [String]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ([String] -> BuildInfo -> [String]
forall a b. a -> b -> a
const []) BuildInfo -> [String] -> BuildInfo
forall a b. a -> b -> a
const


-- | A lens that accesses the ghc options of the PerCompilerFlavor
ghcOptionsL :: Lens' (PerCompilerFlavor [String]) [String]
ghcOptionsL :: Lens' (PerCompilerFlavor [String]) [String]
ghcOptionsL = (PerCompilerFlavor [String] -> [String])
-> (PerCompilerFlavor [String]
    -> [String] -> PerCompilerFlavor [String])
-> Lens' (PerCompilerFlavor [String]) [String]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PerCompilerFlavor [String] -> [String]
forall {v}. PerCompilerFlavor v -> v
getter PerCompilerFlavor [String]
-> [String] -> PerCompilerFlavor [String]
forall {v}. PerCompilerFlavor v -> v -> PerCompilerFlavor v
setter
   where
      getter :: PerCompilerFlavor v -> v
getter (PerCompilerFlavor v
ghcOpts v
_)           = v
ghcOpts
      setter :: PerCompilerFlavor v -> v -> PerCompilerFlavor v
setter (PerCompilerFlavor v
_ v
ghcjsOpts) v
ghcOpts = v -> v -> PerCompilerFlavor v
forall v. v -> v -> PerCompilerFlavor v
PerCompilerFlavor v
ghcOpts v
ghcjsOpts