{-# LANGUAGE OverloadedStrings #-}

module Distribution.Nixpkgs.Haskell.FromCabal.Normalize ( normalize ) where

import Control.Lens
import qualified Data.Set as Set
import Data.String
import Distribution.Nixpkgs.Haskell
import Distribution.Nixpkgs.Meta
import Distribution.Package
import Language.Nix hiding ( quote )

normalize :: Derivation -> Derivation
normalize :: Derivation -> Derivation
normalize Derivation
drv = Derivation
drv
  Derivation -> (Derivation -> Derivation) -> Derivation
forall a b. a -> (a -> b) -> b
& ASetter Derivation Derivation BuildInfo BuildInfo
-> (BuildInfo -> BuildInfo) -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Derivation Derivation BuildInfo BuildInfo
Lens' Derivation BuildInfo
libraryDepends (PackageName -> BuildInfo -> BuildInfo
normalizeBuildInfo (Derivation -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName Derivation
drv))
  Derivation -> (Derivation -> Derivation) -> Derivation
forall a b. a -> (a -> b) -> b
& ASetter Derivation Derivation BuildInfo BuildInfo
-> (BuildInfo -> BuildInfo) -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Derivation Derivation BuildInfo BuildInfo
Lens' Derivation BuildInfo
executableDepends (PackageName -> BuildInfo -> BuildInfo
normalizeBuildInfo (Derivation -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName Derivation
drv))
  Derivation -> (Derivation -> Derivation) -> Derivation
forall a b. a -> (a -> b) -> b
& ASetter Derivation Derivation BuildInfo BuildInfo
-> (BuildInfo -> BuildInfo) -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Derivation Derivation BuildInfo BuildInfo
Lens' Derivation BuildInfo
testDepends (PackageName -> BuildInfo -> BuildInfo
normalizeBuildInfo (Derivation -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName Derivation
drv))
  Derivation -> (Derivation -> Derivation) -> Derivation
forall a b. a -> (a -> b) -> b
& ASetter Derivation Derivation BuildInfo BuildInfo
-> (BuildInfo -> BuildInfo) -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Derivation Derivation BuildInfo BuildInfo
Lens' Derivation BuildInfo
benchmarkDepends (PackageName -> BuildInfo -> BuildInfo
normalizeBuildInfo (Derivation -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName Derivation
drv))
  Derivation -> (Derivation -> Derivation) -> Derivation
forall a b. a -> (a -> b) -> b
& ASetter Derivation Derivation Meta Meta
-> (Meta -> Meta) -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Derivation Derivation Meta Meta
Lens' Derivation Meta
metaSection Meta -> Meta
normalizeMeta
  Derivation -> (Derivation -> Derivation) -> Derivation
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> Derivation -> Identity Derivation
Lens' Derivation Bool
jailbreak ((Bool -> Identity Bool) -> Derivation -> Identity Derivation)
-> (Bool -> Bool) -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Bool -> Bool -> Bool
&& (Derivation -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName Derivation
drv PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
/= PackageName
"jailbreak-cabal"))

normalizeBuildInfo :: PackageName -> BuildInfo -> BuildInfo
normalizeBuildInfo :: PackageName -> BuildInfo -> BuildInfo
normalizeBuildInfo PackageName
pname BuildInfo
bi = BuildInfo
bi
  BuildInfo -> (BuildInfo -> BuildInfo) -> BuildInfo
forall a b. a -> (a -> b) -> b
& (Set Binding -> Identity (Set Binding))
-> BuildInfo -> Identity BuildInfo
Lens' BuildInfo (Set Binding)
haskell ((Set Binding -> Identity (Set Binding))
 -> BuildInfo -> Identity BuildInfo)
-> (Set Binding -> Set Binding) -> BuildInfo -> BuildInfo
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Binding -> Bool) -> Set Binding -> Set Binding
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\Binding
b -> Getting Identifier Binding Identifier -> Binding -> Identifier
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Identifier Binding Identifier
Lens' Binding Identifier
localName Binding
b Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> Identifier
forall a. IsString a => String -> a
fromString (PackageName -> String
unPackageName PackageName
pname))
  BuildInfo -> (BuildInfo -> BuildInfo) -> BuildInfo
forall a b. a -> (a -> b) -> b
& (Set Binding -> Identity (Set Binding))
-> BuildInfo -> Identity BuildInfo
Lens' BuildInfo (Set Binding)
tool ((Set Binding -> Identity (Set Binding))
 -> BuildInfo -> Identity BuildInfo)
-> (Set Binding -> Set Binding) -> BuildInfo -> BuildInfo
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Binding -> Bool) -> Set Binding -> Set Binding
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\Binding
b -> Getting Identifier Binding Identifier -> Binding -> Identifier
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Identifier Binding Identifier
Lens' Binding Identifier
localName Binding
b Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> Identifier
forall a. IsString a => String -> a
fromString (PackageName -> String
unPackageName PackageName
pname))

normalizeMeta :: Meta -> Meta
normalizeMeta :: Meta -> Meta
normalizeMeta Meta
meta = Meta
meta
  Meta -> (Meta -> Meta) -> Meta
forall a b. a -> (a -> b) -> b
& (String -> Identity String) -> Meta -> Identity Meta
Lens' Meta String
description ((String -> Identity String) -> Meta -> Identity Meta)
-> (String -> String) -> Meta -> Meta
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ String -> String
normalizeSynopsis
  Meta -> (Meta -> Meta) -> Meta
forall a b. a -> (a -> b) -> b
& (Set Platform -> Identity (Set Platform)) -> Meta -> Identity Meta
Lens' Meta (Set Platform)
platforms ((Set Platform -> Identity (Set Platform))
 -> Meta -> Identity Meta)
-> (Set Platform -> Set Platform) -> Meta -> Meta
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Set Platform -> Set Platform -> Set Platform
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set Platform
allKnownPlatforms
  Meta -> (Meta -> Meta) -> Meta
forall a b. a -> (a -> b) -> b
& (Set Platform -> Identity (Set Platform)) -> Meta -> Identity Meta
Lens' Meta (Set Platform)
hydraPlatforms ((Set Platform -> Identity (Set Platform))
 -> Meta -> Identity Meta)
-> (Set Platform -> Set Platform) -> Meta -> Meta
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (if Meta
metaMeta -> Getting Bool Meta Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool Meta Bool
Lens' Meta Bool
broken then Set Platform -> Set Platform -> Set Platform
forall a b. a -> b -> a
const Set Platform
forall a. Set a
Set.empty else Set Platform -> Set Platform -> Set Platform
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection (Meta
metaMeta -> Getting (Set Platform) Meta (Set Platform) -> Set Platform
forall s a. s -> Getting a s a -> a
^.Getting (Set Platform) Meta (Set Platform)
Lens' Meta (Set Platform)
platforms))

normalizeSynopsis :: String -> String
normalizeSynopsis :: String -> String
normalizeSynopsis String
desc
  | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
desc                                             = []
  | String -> Char
forall a. [a] -> a
last String
desc Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
&& String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char
'.'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) String
desc) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = String -> String
normalizeSynopsis (String -> String
forall a. [a] -> [a]
init String
desc)
  | Bool
otherwise                                             = String -> String
quote ([String] -> String
unwords (String -> [String]
words String
desc))

quote :: String -> String
quote :: String -> String
quote (Char
'\\':Char
c:String
cs) = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
quote String
cs
quote (Char
'"':String
cs)    = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
quote String
cs
quote (Char
c:String
cs)      = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
quote String
cs
quote []          = []