blob: 6d0bd04716e08a29e4e571b0f99923d2c71f8cb2 (
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
|
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ViewPatterns #-}
module Coolbal.CabalPlan (
CabalPlan(..),
PlanPackage(..),
parseCabalPlan,
) where
import qualified Data.Bytes as Bytes
import Data.Foldable (toList)
import Data.List (find)
import qualified GHC.Exts as IsList (IsList(..))
import qualified Json
data CabalPlan = CabalPlan
{ planCompiler :: String
, planPackages :: [PlanPackage] }
deriving (Show)
data PlanPackage
= PreExisting
{ ppName :: String
, ppVersion :: String
, ppDepends :: [String] }
| Configured
{ ppName :: String
, ppVersion :: String
, ppLocal :: Bool
, ppComponent :: String
, ppDepends :: [String] }
deriving (Show)
parseCabalPlan :: FilePath -> IO (Maybe CabalPlan)
parseCabalPlan fpath = parseFromValue <$> Bytes.readFile fpath
where
parseFromValue (Json.decode -> Right toplevel) = do
Json.Object obj <- return toplevel
Json.String compiler <- locate "compiler-id" obj
Json.Array pkgs <- locate "install-plan" obj
CabalPlan (IsList.toList compiler) <$> mapM parsePackage (toList pkgs)
parseFromValue _ = Nothing
parsePackage value = do
Json.Object obj <- return value
Json.String typ <- locate "type" obj
Json.String name <- locate "pkg-name" obj
Json.String version <- locate "pkg-version" obj
Json.Array dependsArr <- locate "depends" obj
depends <- mapM (\case Json.String s -> Just s ; _ -> Nothing) (toList dependsArr)
if | typ == IsList.fromList "pre-existing" ->
return (PreExisting (IsList.toList name) (IsList.toList version) (map IsList.toList depends))
| typ == IsList.fromList "configured" -> do
Json.String style <- locate "style" obj
Json.String component <- locate "component-name" obj
return (Configured (IsList.toList name) (IsList.toList version)
(style == IsList.fromList "local")
(IsList.toList component)
(map IsList.toList depends))
| otherwise ->
Nothing
locate :: Foldable f => String -> f Json.Member -> Maybe Json.Value
locate key = fmap (\(Json.Member _ v) -> v) . find (\(Json.Member k _) -> k == IsList.fromList key)
|
