Types.hs 5.14 KB
Newer Older
1
{-# language GeneralizedNewtypeDeriving #-}
2 3 4
{-# language DeriveAnyClass #-}
{-# language DerivingStrategies #-}
{-# language DeriveGeneric #-}
5
{-# language OverloadedStrings #-}
Valentin Reis's avatar
Valentin Reis committed
6
{-# language NoImplicitPrelude #-}
7

Valentin Reis's avatar
types.  
Valentin Reis committed
8 9 10 11 12 13 14 15
{-|
Module      : Argo.Types
Description : types for running argo stacks
Copyright   : (c) Valentin Reis, 2018
License     : MIT
Maintainer  : fre@freux.fr
-}

16 17 18 19 20 21 22 23 24 25 26 27
module Argo.Types
  ( StdOutLog(..)
  , StdErrLog(..)
  , TestText(..)
  , ProcessBehavior(..)
  , TextBehavior(..)
  , TextBehaviorStdout(..)
  , TextBehaviorStderr(..)
  , WorkingDirectory(..)
  , Verbosity(..)
  , AppName(..)
  , AppArg(..)
28
  , EnvVar(..)
29 30 31 32 33 34 35 36 37 38 39 40 41 42
  , ContainerName(..)
  , ShareDir(..)
  , ManifestName(..)
  , StackArgs(..)
  , PreludeCommand(..)
  , HwThreadCount(..)
  , PowerCap(..)
  , toOption
  )
where

import           Data.Default
import           Data.Text                     as T
                                         hiding ( empty )
Valentin Reis's avatar
Valentin Reis committed
43
import           Protolude
44 45
import           Data.Yaml
import           Dhall
46 47 48 49

data StackArgs = StackArgs
  { verbosity              :: Verbosity
  , app                    :: AppName
50
  , vars                   :: [(EnvVar,Text)]
51 52 53 54 55 56 57 58 59 60 61 62 63 64
  , args                   :: [AppArg]
  , containerName          :: ContainerName
  , workingDirectory       :: WorkingDirectory
  , shareDir               :: ShareDir
  , manifestName           :: ManifestName
  , preludeCommand         :: PreludeCommand
  , daemon
  , cmdrun
  , cmdlisten
  , cmdlistenprogress
  , cmdlistenperformance
  , cmdlistenpower         :: ProcessBehavior
  , hwThreadCount          :: HwThreadCount
  , powercap               :: PowerCap
65
  } deriving (Show, Generic, ToJSON, FromJSON, Interpret)
66

Valentin Reis's avatar
Valentin Reis committed
67
{-data OutputFiles = OutputFiles Text Text-}
68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104
data Verbosity = Normal | Verbose
  deriving (Show, Read, Eq, Generic, FromJSON, ToJSON, Interpret)
newtype EnvVar = EnvVar Text
  deriving stock (Show, Read, Generic)
  deriving newtype (IsString)
  deriving anyclass (FromJSON, ToJSON, Interpret)
newtype HwThreadCount = HwThreadCount Integer
  deriving stock (Show, Read, Generic)
  deriving anyclass (FromJSON, ToJSON, Interpret)
newtype AppArg = AppArg Text
  deriving stock (Show, Read, Generic)
  deriving newtype (IsString)
  deriving anyclass (FromJSON, ToJSON, Interpret)
newtype WorkingDirectory = WorkingDirectory Text
  deriving stock (Show, Read, Generic)
  deriving newtype (IsString)
  deriving anyclass (FromJSON, ToJSON, Interpret)
newtype AppName = AppName Text
  deriving stock (Show, Read, Generic)
  deriving newtype (IsString)
  deriving anyclass (FromJSON, ToJSON, Interpret)
newtype ContainerName = ContainerName Text
  deriving stock (Show, Read, Generic)
  deriving newtype (IsString)
  deriving anyclass (FromJSON, ToJSON, Interpret)
newtype ShareDir = ShareDir Text
  deriving stock (Show, Read, Generic)
  deriving newtype (IsString)
  deriving anyclass (FromJSON, ToJSON, Interpret)
newtype ManifestName = ManifestName Text
  deriving stock (Show, Read, Generic)
  deriving newtype (IsString)
  deriving anyclass (FromJSON, ToJSON, Interpret)
newtype PreludeCommand = PreludeCommand Text
  deriving stock (Show, Read, Generic)
  deriving newtype (IsString)
  deriving anyclass (FromJSON, ToJSON, Interpret)
105 106 107
data ProcessBehavior =
     Test TestText StdOutLog StdErrLog
   | JustRun StdOutLog StdErrLog
108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
   | DontRun
   deriving (Show,Read, Generic, FromJSON, ToJSON, Interpret)
newtype StdOutLog = StdOutLog Text
  deriving stock (Show, Read, Generic)
  deriving newtype (IsString)
  deriving anyclass (FromJSON, ToJSON, Interpret)
newtype StdErrLog = StdErrLog Text
  deriving stock (Show, Read, Generic)
  deriving newtype (IsString)
  deriving anyclass (FromJSON, ToJSON, Interpret)
data TestText = TestText TextBehaviorStdout TextBehaviorStderr
  deriving stock (Show, Read, Generic)
  deriving anyclass (FromJSON, ToJSON, Interpret)
newtype TextBehaviorStdout = TextBehaviorStdout TextBehavior
  deriving stock (Show, Read, Generic)
  deriving anyclass (FromJSON, ToJSON, Interpret)
newtype TextBehaviorStderr = TextBehaviorStderr TextBehavior
  deriving stock (Show, Read, Generic)
  deriving anyclass (FromJSON, ToJSON, Interpret)
127 128
data TextBehavior =
    WaitFor Text
129 130
  | ExpectClean deriving (Show,Read, Generic, FromJSON, ToJSON, Interpret)
data PowerCap = Fixed Integer | Adaptive | None deriving (Show, Read, Eq, Generic, FromJSON, ToJSON, Interpret)
131 132

class ToDaemonOption a where
Valentin Reis's avatar
Valentin Reis committed
133
  toOption :: a -> [Text]
134 135 136 137 138 139 140 141 142 143 144 145 146 147

instance ToDaemonOption Verbosity where
  toOption Verbose = ["--verbose"]
  toOption Normal = []

instance ToDaemonOption PowerCap where
  toOption (Fixed i) = ["--powercap", show i]
  toOption Adaptive = []
  toOption None = []

instance Default StackArgs where
  def = StackArgs
    { verbosity = Normal
    , app = AppName "ls"
148
    , vars = []
149 150 151 152 153 154 155 156 157 158 159 160 161 162 163
    , args = []
    , containerName = ContainerName "testContainer"
    , workingDirectory = WorkingDirectory "_output"
    , shareDir = ShareDir "/tmp"
    , manifestName = ManifestName "basic.json"
    , preludeCommand = PreludeCommand ""
    , daemon = DontRun
    , cmdrun = DontRun
    , cmdlisten = DontRun
    , cmdlistenprogress = DontRun
    , cmdlistenperformance = DontRun
    , cmdlistenpower = DontRun
    , hwThreadCount = HwThreadCount 1
    , powercap = None
    }