{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
module Drasil.Generator.WriteSystem
  ( drasilMakefileReqOpts,
    concretizeAndWrite,
    setSystemLocale,
    WriteOptions (..),
    DebugDataPolicy (..)
  )
where

import Control.Lens ((^.))
import GHC.IO.Encoding (setLocaleEncoding, utf8, TextEncoding)
import System.Environment (lookupEnv)

import Drasil.FileHandling (OverwritePolicy (..), PathSegment, directory, localPath, ps, writeFiles, FileLayout)
import Drasil.System (HasSystemMeta (..), ToFiles (..), HasProjectName(..))

import Drasil.Generator.ChunkDump (buildDebuggingFiles)

-- | Internal: Set system locale encoding to UTF-8.
setSystemLocale :: IO ()
setSystemLocale :: IO ()
setSystemLocale = TextEncoding -> IO ()
setLocaleEncoding TextEncoding
utf8

{-# DEPRECATED setSystemLocale
  "Use `concretizeAndWrite` instead of directly setting system locale before file-writing." #-}

-- | When should debugging data be written?
data DebugDataPolicy
  = -- | Always.
    AlwaysWrite
      -- | The name of the directory to carry all debugging data files.
      PathSegment
  | -- | Only write debugging data if the following environment variable ('String') is non-empty.
    CheckEnvVar
      -- | The environment variable name.
      String
      -- | The name of the directory to carry all debugging data files.
      PathSegment
  | -- | Never.
    NeverWrite

-- | Configuration options for writing a repository of software artifacts.
data WriteOptions = WO
  { -- | Are we allowed to overwrite files or not?
    WriteOptions -> OverwritePolicy
overwritePolicy :: OverwritePolicy,
    -- | What is the name of the subfolder to be created?
    WriteOptions
-> forall sys.
   (HasSystemMeta sys, HasProjectName sys) =>
   sys -> PathSegment
localDirName :: forall sys. (HasSystemMeta sys, HasProjectName sys) => sys -> PathSegment,
    -- | What is the expected text encoding scheme?
    WriteOptions -> TextEncoding
textEncoding :: TextEncoding,
    -- | Should debugging data be written?
    WriteOptions -> DebugDataPolicy
debugDataPolicy :: DebugDataPolicy
  }

-- | These are the default file-writing 'WriteOptions' required for Drasil (the
-- main Makefile will not play well otherwise).
--
-- Options:
--
-- 1. 'overwritePolicy': Always allow file-overwriting.
-- 2. 'dirName': The example's abbreviation.
-- 3. 'textEncoding': UTF-8.
-- 4. 'debugDataPolicy': Dependant on `DEBUG_ENV` environment variable being
--    set, writing to a nested `.drasil` folder.
drasilMakefileReqOpts :: WriteOptions
drasilMakefileReqOpts :: WriteOptions
drasilMakefileReqOpts =
  OverwritePolicy
-> (forall sys.
    (HasSystemMeta sys, HasProjectName sys) =>
    sys -> PathSegment)
-> TextEncoding
-> DebugDataPolicy
-> WriteOptions
WO OverwritePolicy
OverwriteAllowed sys -> PathSegment
forall {s}. HasProjectName s => s -> PathSegment
forall sys.
(HasSystemMeta sys, HasProjectName sys) =>
sys -> PathSegment
dirName TextEncoding
utf8 (String -> PathSegment -> DebugDataPolicy
CheckEnvVar String
"DEBUG_ENV" [ps|.drasil|])
  where
    dirName :: s -> PathSegment
dirName s
sys = let nm :: String
nm = s
sys s -> Getting String s String -> String
forall s a. s -> Getting a s a -> a
^. Getting String s String
forall c. HasProjectName c => Lens' c String
Lens' s String
projRepoName
                   in [ps|{nm}|]

-- | Internal: 'DebugDataPolicy' eliminator.
debugData :: HasSystemMeta sys => sys -> DebugDataPolicy -> IO (Maybe FileLayout)
debugData :: forall sys.
HasSystemMeta sys =>
sys -> DebugDataPolicy -> IO (Maybe FileLayout)
debugData sys
_ DebugDataPolicy
NeverWrite = Maybe FileLayout -> IO (Maybe FileLayout)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FileLayout
forall a. Maybe a
Nothing
debugData sys
sys (AlwaysWrite PathSegment
dirName) =
  Maybe FileLayout -> IO (Maybe FileLayout)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FileLayout -> IO (Maybe FileLayout))
-> Maybe FileLayout -> IO (Maybe FileLayout)
forall a b. (a -> b) -> a -> b
$ FileLayout -> Maybe FileLayout
forall a. a -> Maybe a
Just (FileLayout -> Maybe FileLayout) -> FileLayout -> Maybe FileLayout
forall a b. (a -> b) -> a -> b
$ PathSegment -> [FileLayout] -> FileLayout
forall (f :: * -> *).
Foldable f =>
PathSegment -> f FileLayout -> FileLayout
directory PathSegment
dirName ([FileLayout] -> FileLayout) -> [FileLayout] -> FileLayout
forall a b. (a -> b) -> a -> b
$ sys -> [FileLayout]
forall sys. HasSystemMeta sys => sys -> [FileLayout]
buildDebuggingFiles sys
sys
debugData sys
sys (CheckEnvVar String
envVar PathSegment
dirName) = do
  maybeDebugging <- String -> IO (Maybe String)
lookupEnv String
envVar
  case maybeDebugging of
    (Just String
v) | Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
v)
      -> Maybe FileLayout -> IO (Maybe FileLayout)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FileLayout -> IO (Maybe FileLayout))
-> Maybe FileLayout -> IO (Maybe FileLayout)
forall a b. (a -> b) -> a -> b
$ FileLayout -> Maybe FileLayout
forall a. a -> Maybe a
Just (FileLayout -> Maybe FileLayout) -> FileLayout -> Maybe FileLayout
forall a b. (a -> b) -> a -> b
$ PathSegment -> [FileLayout] -> FileLayout
forall (f :: * -> *).
Foldable f =>
PathSegment -> f FileLayout -> FileLayout
directory PathSegment
dirName ([FileLayout] -> FileLayout) -> [FileLayout] -> FileLayout
forall a b. (a -> b) -> a -> b
$ sys -> [FileLayout]
forall sys. HasSystemMeta sys => sys -> [FileLayout]
buildDebuggingFiles sys
sys
    Maybe String
_ -> Maybe FileLayout -> IO (Maybe FileLayout)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FileLayout
forall a. Maybe a
Nothing

-- | Concretize a system into a concrete set of files and write them to disk.
--
-- Note: Writes files to a subdirectory of the current working directory.
concretizeAndWrite ::
  (ToFiles sys concOpts) =>
  -- | The system.
  sys ->
  -- | The concretization options.
  concOpts ->
  -- | The file-writing options.
  WriteOptions ->
  -- | Files will be written to a local directory named after the abbreviation
  -- of the system.
  IO ()
concretizeAndWrite :: forall sys concOpts.
ToFiles sys concOpts =>
sys -> concOpts -> WriteOptions -> IO ()
concretizeAndWrite sys
sys concOpts
concOpts WO {TextEncoding
OverwritePolicy
DebugDataPolicy
forall sys.
(HasSystemMeta sys, HasProjectName sys) =>
sys -> PathSegment
overwritePolicy :: WriteOptions -> OverwritePolicy
localDirName :: WriteOptions
-> forall sys.
   (HasSystemMeta sys, HasProjectName sys) =>
   sys -> PathSegment
textEncoding :: WriteOptions -> TextEncoding
debugDataPolicy :: WriteOptions -> DebugDataPolicy
overwritePolicy :: OverwritePolicy
localDirName :: forall sys.
(HasSystemMeta sys, HasProjectName sys) =>
sys -> PathSegment
textEncoding :: TextEncoding
debugDataPolicy :: DebugDataPolicy
..} = do
  TextEncoding -> IO ()
setLocaleEncoding TextEncoding
textEncoding
  debugFiles <- sys -> DebugDataPolicy -> IO (Maybe FileLayout)
forall sys.
HasSystemMeta sys =>
sys -> DebugDataPolicy -> IO (Maybe FileLayout)
debugData sys
sys DebugDataPolicy
debugDataPolicy
  let artifacts = sys -> concOpts -> [FileLayout]
forall sys opts. ToFiles sys opts => sys -> opts -> [FileLayout]
toFiles sys
sys concOpts
concOpts
      artifacts' = [FileLayout]
-> (FileLayout -> [FileLayout]) -> Maybe FileLayout -> [FileLayout]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [FileLayout]
artifacts (FileLayout -> [FileLayout] -> [FileLayout]
forall a. a -> [a] -> [a]
: [FileLayout]
artifacts) Maybe FileLayout
debugFiles
      finalDir = PathSegment -> [FileLayout] -> FileLayout
forall (f :: * -> *).
Foldable f =>
PathSegment -> f FileLayout -> FileLayout
directory (sys -> PathSegment
forall sys.
(HasSystemMeta sys, HasProjectName sys) =>
sys -> PathSegment
localDirName sys
sys) [FileLayout]
artifacts'
  writeFiles overwritePolicy localPath finalDir