126 lines
3.9 KiB
Haskell
126 lines
3.9 KiB
Haskell
{-# OPTIONS_GHC -Wno-orphans #-}
|
|
|
|
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
|
|
module GHCup.Types.JSON where
|
|
|
|
import GHCup.Types
|
|
import Data.Versions
|
|
import Data.Aeson
|
|
import Data.Aeson.TH
|
|
import Network.URL
|
|
import qualified Data.Text as T
|
|
import Data.Aeson.Types
|
|
import Data.Text.Encoding as E
|
|
|
|
|
|
|
|
|
|
deriveJSON defaultOptions ''Architecture
|
|
deriveJSON defaultOptions ''LinuxDistro
|
|
deriveJSON defaultOptions ''Mess
|
|
deriveJSON defaultOptions ''Platform
|
|
deriveJSON defaultOptions ''SemVer
|
|
deriveJSON defaultOptions ''Tool
|
|
deriveJSON defaultOptions ''VSep
|
|
deriveJSON defaultOptions ''VUnit
|
|
|
|
|
|
instance ToJSON URL where
|
|
toJSON = toJSON . exportURL
|
|
|
|
instance FromJSON URL where
|
|
parseJSON = withText "URL" $ \t -> case importURL (T.unpack t) of
|
|
Just x -> pure x
|
|
Nothing -> fail "Could not parse URL, failure in importURL"
|
|
|
|
instance ToJSON Versioning where
|
|
toJSON = toJSON . prettyV
|
|
|
|
instance FromJSON Versioning where
|
|
parseJSON = withText "Versioning" $ \t -> case versioning t of
|
|
Right x -> pure x
|
|
Left e -> fail $ "Failure in Version (FromJSON)" <> show e
|
|
|
|
instance ToJSONKey Versioning where
|
|
toJSONKey = toJSONKeyText $ \x -> prettyV x
|
|
|
|
instance FromJSONKey Versioning where
|
|
fromJSONKey = FromJSONKeyTextParser $ \t -> case versioning t of
|
|
Right x -> pure x
|
|
Left e -> fail $ "Failure in Versioning (FromJSONKey)" <> show e
|
|
|
|
instance ToJSONKey (Maybe Versioning) where
|
|
toJSONKey = toJSONKeyText $ \case
|
|
Just x -> prettyV x
|
|
Nothing -> T.pack "unknown"
|
|
|
|
instance FromJSONKey (Maybe Versioning) where
|
|
fromJSONKey = FromJSONKeyTextParser
|
|
$ \t -> if t == T.pack "unknown" then pure Nothing else pure $ just t
|
|
where
|
|
just t = case versioning t of
|
|
Right x -> pure x
|
|
Left e -> fail $ "Failure in (Maybe Versioning) (FromJSONKey)" <> show e
|
|
|
|
instance ToJSONKey Platform where
|
|
toJSONKey = toJSONKeyText $ \case
|
|
Darwin -> T.pack "Darwin"
|
|
FreeBSD -> T.pack "FreeBSD"
|
|
Linux d -> T.pack ("Linux_" <> show d)
|
|
|
|
instance FromJSONKey Platform where
|
|
fromJSONKey = FromJSONKeyTextParser $ \t -> if
|
|
| T.pack "Darwin" == t -> pure Darwin
|
|
| T.pack "FreeBSD" == t -> pure FreeBSD
|
|
| T.pack "Linux_" `T.isPrefixOf` t -> case
|
|
T.stripPrefix (T.pack "Linux_") t
|
|
of
|
|
Just dstr ->
|
|
case
|
|
(decodeStrict (E.encodeUtf8 (T.pack "\"" <> dstr <> T.pack "\"")) :: Maybe
|
|
LinuxDistro
|
|
)
|
|
of
|
|
Just d -> pure $ Linux d
|
|
Nothing ->
|
|
fail
|
|
$ "Unexpected failure in decoding LinuxDistro: "
|
|
<> show dstr
|
|
Nothing -> fail "Unexpected failure in Platform stripPrefix"
|
|
| otherwise -> fail $ "Failure in Platform (FromJSONKey)"
|
|
|
|
instance ToJSONKey Architecture where
|
|
toJSONKey = genericToJSONKey defaultJSONKeyOptions
|
|
|
|
instance FromJSONKey Architecture where
|
|
fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
|
|
|
|
instance ToJSON Version where
|
|
toJSON = toJSON . prettyVer
|
|
|
|
instance FromJSON Version where
|
|
parseJSON = withText "Version" $ \t -> case version t of
|
|
Right x -> pure x
|
|
Left e -> fail $ "Failure in Version (FromJSON)" <> show e
|
|
|
|
instance ToJSONKey Version where
|
|
toJSONKey = toJSONKeyText $ \x -> prettyVer x
|
|
|
|
instance FromJSONKey Version where
|
|
fromJSONKey = FromJSONKeyTextParser $ \t -> case version t of
|
|
Right x -> pure x
|
|
Left e -> fail $ "Failure in Version (FromJSONKey)" <> show e
|
|
|
|
instance ToJSONKey Tool where
|
|
toJSONKey = genericToJSONKey defaultJSONKeyOptions
|
|
|
|
instance FromJSONKey Tool where
|
|
fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
|