-- | Things that seem like they could be clients of this library, but
-- are instead included as part of the library.
{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}
{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
module Debian.Debianize.ExecAtoms
    ( execAtoms
    ) where

import Control.Lens ( over, (%=) )
import Data.Maybe ( fromMaybe )
import Data.Set as Set ( insert )
import Data.Text as Text ( pack )
import qualified Debian.Debianize.DebInfo as D
    ( InstallFile(destName, destDir, execName, sourceDir),
      Atom(InstallTo, InstallCabalExecTo, Install, InstallCabalExec),
      rulesFragments,
      atomSet )
import Debian.Debianize.Monad ( CabalInfo, execCabalM )
import qualified Debian.Debianize.CabalInfo as A ( debInfo )
import qualified Debian.Debianize.BinaryDebDescription as B ()
import Debian.Pretty ( ppShow )
import Debian.Relation ( BinPkgName )
import System.FilePath ( (</>) )

execAtoms :: BinPkgName -> D.InstallFile -> CabalInfo -> CabalInfo
execAtoms :: BinPkgName -> InstallFile -> CabalInfo -> CabalInfo
execAtoms BinPkgName
b InstallFile
ifile CabalInfo
r =
    ASetter CabalInfo CabalInfo (Set Text) (Set Text)
-> (Set Text -> Set Text) -> CabalInfo -> CabalInfo
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo)
-> ((Set Text -> Identity (Set Text))
    -> DebInfo -> Identity DebInfo)
-> ASetter CabalInfo CabalInfo (Set Text) (Set Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Text -> Identity (Set Text)) -> DebInfo -> Identity DebInfo
Lens' DebInfo (Set Text)
D.rulesFragments) (Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert (String -> Text
pack (String
"build" String -> String -> String
</> BinPkgName -> String
forall a. Pretty (PP a) => a -> String
ppShow BinPkgName
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":: build-ghc-stamp\n"))) (CabalInfo -> CabalInfo)
-> (CabalInfo -> CabalInfo) -> CabalInfo -> CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    BinPkgName -> InstallFile -> CabalInfo -> CabalInfo
fileAtoms BinPkgName
b InstallFile
ifile (CabalInfo -> CabalInfo) -> CabalInfo -> CabalInfo
forall a b. (a -> b) -> a -> b
$
    CabalInfo
r

fileAtoms :: BinPkgName -> D.InstallFile -> CabalInfo -> CabalInfo
fileAtoms :: BinPkgName -> InstallFile -> CabalInfo -> CabalInfo
fileAtoms BinPkgName
b InstallFile
installFile' CabalInfo
r =
    BinPkgName
-> Maybe String
-> String
-> Maybe String
-> String
-> CabalInfo
-> CabalInfo
fileAtoms' BinPkgName
b (InstallFile -> Maybe String
D.sourceDir InstallFile
installFile') (InstallFile -> String
D.execName InstallFile
installFile') (InstallFile -> Maybe String
D.destDir InstallFile
installFile') (InstallFile -> String
D.destName InstallFile
installFile') CabalInfo
r

fileAtoms' :: BinPkgName -> Maybe FilePath -> String -> Maybe FilePath -> String -> CabalInfo -> CabalInfo
fileAtoms' :: BinPkgName
-> Maybe String
-> String
-> Maybe String
-> String
-> CabalInfo
-> CabalInfo
fileAtoms' BinPkgName
b Maybe String
sourceDir' String
execName' Maybe String
destDir' String
destName' CabalInfo
r =
    case (Maybe String
sourceDir', String
execName' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
destName') of
      (Maybe String
Nothing, Bool
True) -> CabalM () -> CabalInfo -> CabalInfo
forall a. CabalM a -> CabalInfo -> CabalInfo
execCabalM (((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo)
-> ((Set Atom -> Identity (Set Atom))
    -> DebInfo -> Identity DebInfo)
-> (Set Atom -> Identity (Set Atom))
-> CabalInfo
-> Identity CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Atom -> Identity (Set Atom)) -> DebInfo -> Identity DebInfo
Lens' DebInfo (Set Atom)
D.atomSet) ((Set Atom -> Identity (Set Atom))
 -> CabalInfo -> Identity CabalInfo)
-> (Set Atom -> Set Atom) -> CabalM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Atom -> Set Atom -> Set Atom
forall a. Ord a => a -> Set a -> Set a
Set.insert (Atom -> Set Atom -> Set Atom) -> Atom -> Set Atom -> Set Atom
forall a b. (a -> b) -> a -> b
$ BinPkgName -> String -> String -> Atom
D.InstallCabalExec BinPkgName
b String
execName' String
d)) CabalInfo
r
      (Just String
s, Bool
True) -> CabalM () -> CabalInfo -> CabalInfo
forall a. CabalM a -> CabalInfo -> CabalInfo
execCabalM (((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo)
-> ((Set Atom -> Identity (Set Atom))
    -> DebInfo -> Identity DebInfo)
-> (Set Atom -> Identity (Set Atom))
-> CabalInfo
-> Identity CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Atom -> Identity (Set Atom)) -> DebInfo -> Identity DebInfo
Lens' DebInfo (Set Atom)
D.atomSet) ((Set Atom -> Identity (Set Atom))
 -> CabalInfo -> Identity CabalInfo)
-> (Set Atom -> Set Atom) -> CabalM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Atom -> Set Atom -> Set Atom
forall a. Ord a => a -> Set a -> Set a
Set.insert (Atom -> Set Atom -> Set Atom) -> Atom -> Set Atom -> Set Atom
forall a b. (a -> b) -> a -> b
$ BinPkgName -> String -> String -> Atom
D.Install BinPkgName
b (String
s String -> String -> String
</> String
execName') String
d)) CabalInfo
r
      (Maybe String
Nothing, Bool
False) -> CabalM () -> CabalInfo -> CabalInfo
forall a. CabalM a -> CabalInfo -> CabalInfo
execCabalM (((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo)
-> ((Set Atom -> Identity (Set Atom))
    -> DebInfo -> Identity DebInfo)
-> (Set Atom -> Identity (Set Atom))
-> CabalInfo
-> Identity CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Atom -> Identity (Set Atom)) -> DebInfo -> Identity DebInfo
Lens' DebInfo (Set Atom)
D.atomSet) ((Set Atom -> Identity (Set Atom))
 -> CabalInfo -> Identity CabalInfo)
-> (Set Atom -> Set Atom) -> CabalM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Atom -> Set Atom -> Set Atom
forall a. Ord a => a -> Set a -> Set a
Set.insert (Atom -> Set Atom -> Set Atom) -> Atom -> Set Atom -> Set Atom
forall a b. (a -> b) -> a -> b
$ BinPkgName -> String -> String -> Atom
D.InstallCabalExecTo BinPkgName
b String
execName' (String
d String -> String -> String
</> String
destName'))) CabalInfo
r
      (Just String
s, Bool
False) -> CabalM () -> CabalInfo -> CabalInfo
forall a. CabalM a -> CabalInfo -> CabalInfo
execCabalM (((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo)
-> ((Set Atom -> Identity (Set Atom))
    -> DebInfo -> Identity DebInfo)
-> (Set Atom -> Identity (Set Atom))
-> CabalInfo
-> Identity CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Atom -> Identity (Set Atom)) -> DebInfo -> Identity DebInfo
Lens' DebInfo (Set Atom)
D.atomSet) ((Set Atom -> Identity (Set Atom))
 -> CabalInfo -> Identity CabalInfo)
-> (Set Atom -> Set Atom) -> CabalM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Atom -> Set Atom -> Set Atom
forall a. Ord a => a -> Set a -> Set a
Set.insert (Atom -> Set Atom -> Set Atom) -> Atom -> Set Atom -> Set Atom
forall a b. (a -> b) -> a -> b
$ BinPkgName -> String -> String -> Atom
D.InstallTo BinPkgName
b (String
s String -> String -> String
</> String
execName') (String
d String -> String -> String
</> String
destName'))) CabalInfo
r
    where
      d :: String
d = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"usr/bin" Maybe String
destDir'