summaryrefslogtreecommitdiff
path: root/src/Job/Types.hs
blob: d9fa08e701a0bf70947615ffb6596be4004710e3 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
module Job.Types where

import Data.Kind
import Data.Text (Text)
import Data.Text qualified as T

import System.FilePath.Glob
import System.Process

import Destination
import Repo


data Declared
data Evaluated

data Job' d = Job
    { jobId :: JobId' d
    , jobName :: JobName
    , jobCheckout :: [ JobCheckout d ]
    , jobRecipe :: [ CreateProcess ]
    , jobArtifacts :: [ ( ArtifactName, Pattern ) ]
    , jobUses :: [ ArtifactSpec ]
    , jobPublish :: [ JobPublish d ]
    }

type Job = Job' Evaluated
type DeclaredJob = Job' Declared

type family JobId' d :: Type where
    JobId' Declared = JobName
    JobId' Evaluated = JobId

data JobName = JobName Text
    deriving (Eq, Ord, Show)

stringJobName :: JobName -> String
stringJobName (JobName name) = T.unpack name

textJobName :: JobName -> Text
textJobName (JobName name) = name


type family JobRepo d :: Type where
    JobRepo Declared = Maybe ( RepoName, Maybe Text )
    JobRepo Evaluated = Tree

data JobCheckout d = JobCheckout
    { jcRepo :: JobRepo d
    , jcSubtree :: Maybe FilePath
    , jcDestination :: Maybe FilePath
    }

type family JobDestination d :: Type where
    JobDestination Declared = DestinationName
    JobDestination Evaluated = Destination

data JobPublish d = JobPublish
    { jpArtifact :: ArtifactSpec
    , jpDestination :: JobDestination d
    , jpPath :: Maybe FilePath
    }


data ArtifactName = ArtifactName Text
    deriving (Eq, Ord, Show)

type ArtifactSpec = ( JobName, ArtifactName )


data JobSet' d = JobSet
    { jobsetId :: JobSetId' d
    , jobsetCommit :: Maybe Commit
    , jobsetExplicitlyRequested :: [ JobId' d ]
    , jobsetJobsEither :: Either String [ Job' d ]
    }

type JobSet = JobSet' Evaluated
type DeclaredJobSet = JobSet' Declared

type family JobSetId' d :: Type where
    JobSetId' Declared = ()
    JobSetId' Evaluated = JobSetId

jobsetJobs :: JobSet -> [ Job ]
jobsetJobs = either (const []) id . jobsetJobsEither


newtype JobId = JobId [ JobIdPart ]
    deriving (Eq, Ord)

newtype JobSetId = JobSetId [ JobIdPart ]
    deriving (Eq, Ord)

data JobIdPart
    = JobIdName JobName
    | JobIdCommit (Maybe RepoName) CommitId
    | JobIdTree (Maybe RepoName) FilePath TreeId
    deriving (Eq, Ord)

newtype JobRef = JobRef [ Text ]
    deriving (Eq, Ord)

textJobIdPart :: JobIdPart -> Text
textJobIdPart = \case
    JobIdName name -> textJobName name
    JobIdCommit _ cid -> textCommitId cid
    JobIdTree _ _ tid -> textTreeId tid

textJobId :: JobId -> Text
textJobId (JobId ids) = T.intercalate "." $ map textJobIdPart ids

parseJobRef :: Text -> JobRef
parseJobRef = JobRef . go 0 ""
  where
    go :: Int -> Text -> Text -> [ Text ]
    go plevel cur s = do
        let bchars | plevel > 0 = [ '(', ')' ]
                   | otherwise  = [ '.', '(', ')' ]
        let ( part, rest ) = T.break (`elem` bchars) s
        case T.uncons rest of
            Just ( '.', rest' ) -> (cur <> part) : go plevel "" rest'
            Just ( '(', rest' ) -> go (plevel + 1) (cur <> part) rest'
            Just ( ')', rest' ) -> go (plevel - 1) (cur <> part) rest'
            _                   -> [ cur <> part ]