{-# 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 Biegunka.Primitive
  ( -- * Actions layer primitives
    link, register, copy, substitute, patch
  , shell, raw
    -- * Modifiers
  , profile, group
  , sudo, reacting, prerequisiteOf, (<~>)
  ) where

import Data.Monoid (mempty)

import           Control.Lens
import qualified Data.Set as S
import           System.FilePath ((</>))
import           System.FilePath.Lens
import           System.Process (CmdSpec(..))
import           Text.StringTemplate (newSTMP, render, setAttribute)

import Biegunka.Language
import Biegunka.Script


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 inner = do
  p <- Script $ use profileName
  Script $ do
    p' <- profileName <</>= name
    profiles . contains p' .= True
  a <- inner
  Script $ profileName .= p
  return a
{-# INLINE profile #-}

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

-- | 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) (constructDestinationFilepath rfp src dst))
{-# INLINE link #-}

-- | Copies given file 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 src dst = actioned (\rfp sfp -> Copy (sfp </> src) (constructDestinationFilepath rfp src dst))
{-# 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) (constructDestinationFilepath rfp src dst)
    (\b -> render . setAttribute "template" b . newSTMP))
{-# 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 #-}


-- | Executes shell command with default shell
--
-- > git "https://example.com/source.git" "git/source" $
-- >   shell "echo hello"
--
-- Prints \"hello\\n\" to stdout
shell :: String -> Script Actions ()
shell command = actioned (\_ sfp -> Command sfp (ShellCommand command))
{-# INLINE shell #-}

-- | Executes raw command
--
-- > git "https://example.com/source.git" "git/source" $
-- >   raw "/bin/echo" ["-n", "hello"]
--
-- Prints \"hello\" to stdout
raw :: FilePath -> [String] -> Script Actions ()
raw command args = actioned (\_ sfp -> Command sfp (RawCommand command args))
{-# INLINE raw #-}

-- | Change effective user id for wrapped commands
sudo :: String -> Script s a -> Script s a
sudo username inner = do
  script (TM (User (Just username)) ())
  a <- inner
  script (TM (User Nothing) ())
  return a
{-# INLINE sudo #-}

-- | Change reaction pattern for wrapped commands
reacting :: React -> Script s a -> Script s a
reacting reaction inner = do
  script (TM (Reacting (Just reaction)) ())
  a <- inner
  script (TM (Reacting Nothing) ())
  return a
{-# 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 $ use token
  a
  t <- Script $ use token
  script (TM (Wait (S.fromList [s .. t - 1])) ())
  b
{-# INLINE prerequisiteOf #-}

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