{-# LANGUAGE DataKinds #-}
-- | Language primitives
--
-- Containts 'Actions' layer primitive and modifiers.
-- 'Sources' layer primitives are found in 'Biegunka.Source.*' modules
--
-- All concrete primitives docs assume you have default settings
module Control.Biegunka.Primitive
  ( -- * Actions layer primitives
    link, register, copy, copyFile, copyDirectory, substitute, patch
  , raw
    -- * Modifiers
  , profile, group, role
  , sudo, retries, reacting, prerequisiteOf, (<~>)
  ) where

import Data.Monoid (mempty)

import           Control.Lens
import           Control.Monad.Reader (local)
import qualified Data.Set as S
import           System.FilePath ((</>))
import           System.FilePath.Lens
import           System.Command.QQ (Eval(..))

import Control.Biegunka.Language
import Control.Biegunka.Script
import Control.Biegunka.Script.Token (peek)
import Control.Biegunka.Templates


infixr 7 `prerequisiteOf`, <~>


-- | Provides convenient 'Sources' grouping. May be nested
--
-- Information about sources and files related to a particular
-- profile @profile@ could be found in @~\/.biegunka\/profiles\/@.
--
-- Example usage:
--
-- > profile "dotfiles" $ do
-- >   group "mine" $
-- >     git "https://github.com/supki/.dotfiles"
-- >       ...
-- >   group "not-mine" $
-- >     git "https://github.com/dmalikov/dotfiles"
-- >       ...
-- > profile "experimental" $ do
-- >   git "https://github.com/ekmett/lens"
-- >     ...
profile :: String -> Script Sources a -> Script Sources a
profile name (Script inner) = Script $
  local (profileName </>~ name) $ do
    p' <- view profileName
    profiles . contains p' .= True
    inner
{-# INLINE profile #-}

-- | Alias for 'profile'. May be useful for nested grouping
group :: String -> Script Sources a -> Script Sources a
group = profile
{-# INLINE group #-}

-- | Alias for 'profile'. Everyone uses roles for something
role :: String -> Script Sources a -> Script Sources a
role = profile
{-# INLINE role #-}

-- | Links source to specified filepath
--
-- > git "https://example.com/source.git" "git/source" $
-- >   register "somewhere"
--
-- Links @~\/git\/source@ to @~\/somewhere@.
register :: FilePath -> Script Actions ()
register dst = actioned (\rfp _ -> Link mempty (rfp </> dst))
{-# INLINE register #-}

-- | Links given file to specified filepath
--
-- > git "https://example.com/source.git" "git/source" $
-- >   link "some-file" "anywhere"
--
-- Links @~\/git\/source\/some-file@ to @~\/anywhere@.
link :: FilePath -> FilePath -> Script Actions ()
link src dst = actioned (\rfp sfp -> Link (sfp </> src) (constructTargetFilePath rfp src dst))
{-# INLINE link #-}

-- | Copies file or directory to specified filepath
--
-- > git "https://example.com/source.git" "git/source" $
-- >   copy "some-file" "anywhere"
--
-- Copies @~\/git\/source\/some-file@ to @~\/anywhere@.
copy :: FilePath -> FilePath -> Script Actions ()
copy = copy' BothDirectoriesAndFiles
{-# INLINE copy #-}

-- | Copies only single file to specified filepath
--
-- > git "https://example.com/source.git" "git/source" $
-- >   copy "some-file" "anywhere"
--
-- Copies @~\/git\/source\/some-file@ to @~\/anywhere@.
copyFile :: FilePath -> FilePath -> Script Actions ()
copyFile = copy' OnlyFiles
{-# INLINE copyFile #-}

-- | Copies file or directory to specified filepath
--
-- > git "https://example.com/source.git" "git/source" $
-- >   copy "some-file" "anywhere"
--
-- Copies @~\/git\/source\/some-file@ to @~\/anywhere@.
copyDirectory :: FilePath -> FilePath -> Script Actions ()
copyDirectory = copy' OnlyDirectories
{-# INLINE copyDirectory #-}

copy' :: CopySpec -> FilePath -> FilePath -> Script Actions ()
copy' spec src dst = actioned (\rfp sfp ->
  Copy (sfp </> src) (constructTargetFilePath rfp src dst) spec)
{-# INLINE copy' #-}

-- | Substitutes templates in @HStringTemplate@ syntax
-- in given file and writes result to specified filepath
--
-- > git "https://example.com/source.git" "git/source" $
-- >   substitute "some-file.template" "anywhere"
--
-- Copies @~\/git\/source\/some-file.template@ to @~\/anywhere@.
--
-- Substitutes templates in @~\/anywhere@ with values from
-- 'templates' part of 'Controls'
substitute :: FilePath -> FilePath -> Script Actions ()
substitute src dst = actioned (\rfp sfp ->
  Template (sfp </> src) (constructTargetFilePath rfp src dst) templating)
{-# INLINE substitute #-}

-- | Applies the patch given the 'PatchSpec'
--
-- > git "https://example.com/source.git" "git/source" $
-- >   patch "some-patch.patch" "anywhere" (def { reversely = True })
--
-- Applies @~\/git\/source\/some-patch.patch@ to @~\/anywhere@ reversely.
patch :: FilePath -> FilePath -> PatchSpec -> Script Actions ()
patch src dst spec = actioned (\rfp sfp -> Patch (sfp </> src) (rfp </> dst) spec)
{-# INLINE patch #-}


-- | Monomorphised interface to 'sh' quasiquoter for
-- those who do not like @-XTemplateHaskell@ (or @-XQuasiQuotes@)
--
-- > git "https://example.com/source.git" "git/source" $
-- >   raw "/bin/echo" ["-n", "hello"]
--
-- Prints \"hello\" to stdout
raw :: FilePath -> [String] -> Script Actions ()
raw = eval
{-# INLINE raw #-}

-- | Change effective user id for wrapped commands
sudo :: User u -> Script s a -> Script s a
sudo user (Script inner) = Script $
  (activeUser ?~ UserW user) `local` inner
{-# INLINE sudo #-}

-- | Change maximum retries count
retries :: Int -> Script s a -> Script s a
retries count (Script inner) = Script $
  set maxRetries (Retry count) `local` inner
{-# INLINE retries #-}

-- | Change reaction pattern when retries are all failed
reacting :: React -> Script s a -> Script s a
reacting reaction (Script inner) = Script $
  (set actionReaction reaction . set sourceReaction reaction) `local` inner
{-# INLINE reacting #-}

-- | Execute scripts sequentially
-- Connects two scripts which forces them to run sequentially one after another.
prerequisiteOf :: Script Sources a -> Script Sources b -> Script Sources b
prerequisiteOf a b = do
  s <- Script peek
  a
  t <- Script peek
  script (TM (Wait (S.fromList [s .. pred t])) ())
  b
{-# INLINE prerequisiteOf #-}

-- | Infix alias for 'prerequisiteOf'
(<~>) :: Script Sources a -> Script Sources b -> Script Sources b
(<~>) = prerequisiteOf
{-# INLINE (<~>) #-}