From d593f919be8d27677181903d39091d74489466e3 Mon Sep 17 00:00:00 2001 From: Ajeet D'Souza <98ajeet@gmail.com> Date: Thu, 13 Jun 2019 13:09:53 +0530 Subject: [PATCH] Format with stylish-haskell --- src/CI.hs | 58 +++++++++++------------ src/CI/TH.hs | 12 ++--- src/CI/Types.hs | 121 +++++++++++++++++++++++------------------------- 3 files changed, 92 insertions(+), 99 deletions(-) diff --git a/src/CI.hs b/src/CI.hs index cff6e5d..bf2e926 100644 --- a/src/CI.hs +++ b/src/CI.hs @@ -1,53 +1,51 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell #-} -module CI ( Types.CI(..), isCI, getCI ) where +module CI (Types.CI(..), isCI, getCI) where -import CI.TH ( getVendors ) +import CI.TH (getVendors) import qualified CI.Types as Types - -import Control.Arrow ( (***) ) - -import Data.Bool ( bool ) -import Data.Foldable ( find ) +import Control.Arrow ((***)) +import Data.Bool (bool) +import Data.Foldable (find) import qualified Data.HashMap.Strict as HashMap -import Data.Maybe ( isJust ) +import Data.Maybe (isJust) import qualified Data.Text as T - -import System.Environment ( getEnvironment ) +import System.Environment (getEnvironment) vendors :: [Types.Vendor] vendors = $(getVendors) getCI :: IO (Maybe Types.CI) getCI = do - env <- mkEnvMap <$> getEnvironment - let maybeVendor = find (checkVendor env) vendors - return $ case maybeVendor of - Nothing -> bool Nothing (Just Types.CI_UNKNOWN_VENDOR) $ - checkUnknownVendor env - Just vendor -> Just $ Types.vendorConstant vendor + env <- mkEnvMap <$> getEnvironment + let maybeVendor = find (checkVendor env) vendors + return + $ case maybeVendor of + Nothing -> bool Nothing (Just Types.CI_UNKNOWN_VENDOR) + $ checkUnknownVendor env + Just vendor -> Just $ Types.vendorConstant vendor where checkVendor env vendor = case Types.vendorEnv vendor of - (Types.VendorEnvString text) -> HashMap.member text env - (Types.VendorEnvList list) -> all (`HashMap.member` env) list - (Types.VendorEnvObject hashMap) -> - all (\(k, v) -> HashMap.lookup k env == Just v) $ - HashMap.toList hashMap + (Types.VendorEnvString text) -> HashMap.member text env + (Types.VendorEnvList list) -> all (`HashMap.member` env) list + (Types.VendorEnvObject hashMap) -> all + (\(k, v) -> HashMap.lookup k env == Just v) + $ HashMap.toList hashMap -- check vendor neutral environment variables checkUnknownVendor env = any (`HashMap.member` env) unknownVendorEnvVars - unknownVendorEnvVars = - map Types.EnvVarName - [ "CI" -- Travis CI, CircleCI, Cirrus CI, Gitlab CI, Appveyor, CodeShip, dsari - , "CONTINUOUS_INTEGRATION" -- Travis CI, Cirrus CI - , "BUILD_NUMBER" -- Jenkins, TeamCity - , "RUN_ID" -- TaskCluster, dsari - ] + unknownVendorEnvVars = map + Types.EnvVarName + [ "CI" -- Travis CI, CircleCI, Cirrus CI, Gitlab CI, Appveyor, CodeShip, dsari + , "CONTINUOUS_INTEGRATION" -- Travis CI, Cirrus CI + , "BUILD_NUMBER" -- Jenkins, TeamCity + , "RUN_ID" -- TaskCluster, dsari + ] mkEnvMap = HashMap.fromList - . map (Types.EnvVarName . T.pack *** Types.EnvVarValue . T.pack) + . map (Types.EnvVarName . T.pack *** Types.EnvVarValue . T.pack) isCI :: IO Bool isCI = isJust <$> getCI diff --git a/src/CI/TH.hs b/src/CI/TH.hs index 06d32f8..578d1b9 100644 --- a/src/CI/TH.hs +++ b/src/CI/TH.hs @@ -1,9 +1,7 @@ -module CI.TH ( getVendors ) where +module CI.TH (getVendors) where import qualified CI.Types as Types - import qualified Data.Aeson as Aeson - import qualified Language.Haskell.TH as TH import qualified Language.Haskell.TH.Syntax as TH @@ -14,7 +12,7 @@ getVendors = TH.runIO readVendors >>= TH.lift readVendors :: IO [Types.Vendor] readVendors = do - vendors <- Aeson.eitherDecodeFileStrict' vendorsPath - case vendors of - Left e -> fail $ "parsing vendors.json failed: " <> e - Right v -> return v + vendors <- Aeson.eitherDecodeFileStrict' vendorsPath + case vendors of + Left e -> fail $ "parsing vendors.json failed: " <> e + Right v -> return v diff --git a/src/CI/Types.hs b/src/CI/Types.hs index e7779e5..1082cd0 100644 --- a/src/CI/Types.hs +++ b/src/CI/Types.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE DeriveLift #-} +{-# LANGUAGE DeriveLift #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -11,94 +11,91 @@ module CI.Types , Vendor(..) , VendorEnv(..) , EnvVarName(..) - , EnvVarValue(..) - ) where + , EnvVarValue(..)) where import qualified Data.Aeson as Aeson import qualified Data.Aeson.Casing as Aeson import qualified Data.Aeson.TH as Aeson -import Data.HashMap.Strict ( HashMap ) +import Data.Hashable (Hashable) +import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap -import Data.Hashable ( Hashable ) -import Data.Text ( Text ) +import Data.Text (Text) import qualified Data.Text as T - import Instances.TH.Lift () - import qualified Language.Haskell.TH.Syntax as TH data CI = - CI_APPVEYOR -- http://www.appveyor.com/ - | CI_AZURE_PIPELINES -- https://azure.microsoft.com/en-us/services/devops/pipelines/ - | CI_BAMBOO -- https://www.atlassian.com/software/bamboo/ - | CI_BITBUCKET -- https://bitbucket.org/product/features/pipelines/ - | CI_BITRISE -- https://www.bitrise.io/ - | CI_BUDDY -- https://buddy.works/ - | CI_BUILDKITE -- https://buildkite.com/ - | CI_CIRCLE -- http://circleci.com/ - | CI_CIRRUS -- https://cirrus-ci.org/ - | CI_CODEBUILD -- https://aws.amazon.com/codebuild/ - | CI_CODESHIP -- https://codeship.com/ - | CI_DRONE -- https://drone.io/ - | CI_DSARI -- https://github.com/rfinnie/dsari/ - | CI_GITLAB -- https://about.gitlab.com/gitlab-ci/ - | CI_GOCD -- https://www.go.cd/ - | CI_HUDSON -- http://hudson-ci.org/ - | CI_JENKINS -- https://jenkins-ci.org/ - | CI_MAGNUM -- https://magnum-ci.com/ - | CI_NETLIFY -- https://www.netlify.com/ - | CI_NEVERCODE -- http://nevercode.io/ - | CI_SAIL -- https://sail.ci/ - | CI_SEMAPHORE -- https://semaphoreci.com/ - | CI_SHIPPABLE -- https://www.shippable.com/ - | CI_SOLANO -- https://www.solanolabs.com/ - | CI_STRIDER -- https://strider-cd.github.io/ - | CI_TASKCLUSTER -- http://docs.taskcluster.net/ - | CI_TEAMCITY -- https://www.jetbrains.com/teamcity/ - | CI_TRAVIS -- http://travis-ci.org/ - | CI_UNKNOWN_VENDOR - deriving ( Eq, Show, TH.Lift ) - -$(Aeson.deriveJSON Aeson.defaultOptions { Aeson.constructorTagModifier = - drop $ T.length "CI_" - } - ''CI) + CI_APPVEYOR -- http://www.appveyor.com/ + | CI_AZURE_PIPELINES -- https://azure.microsoft.com/en-us/services/devops/pipelines/ + | CI_BAMBOO -- https://www.atlassian.com/software/bamboo/ + | CI_BITBUCKET -- https://bitbucket.org/product/features/pipelines/ + | CI_BITRISE -- https://www.bitrise.io/ + | CI_BUDDY -- https://buddy.works/ + | CI_BUILDKITE -- https://buildkite.com/ + | CI_CIRCLE -- http://circleci.com/ + | CI_CIRRUS -- https://cirrus-ci.org/ + | CI_CODEBUILD -- https://aws.amazon.com/codebuild/ + | CI_CODESHIP -- https://codeship.com/ + | CI_DRONE -- https://drone.io/ + | CI_DSARI -- https://github.com/rfinnie/dsari/ + | CI_GITLAB -- https://about.gitlab.com/gitlab-ci/ + | CI_GOCD -- https://www.go.cd/ + | CI_HUDSON -- http://hudson-ci.org/ + | CI_JENKINS -- https://jenkins-ci.org/ + | CI_MAGNUM -- https://magnum-ci.com/ + | CI_NETLIFY -- https://www.netlify.com/ + | CI_NEVERCODE -- http://nevercode.io/ + | CI_SAIL -- https://sail.ci/ + | CI_SEMAPHORE -- https://semaphoreci.com/ + | CI_SHIPPABLE -- https://www.shippable.com/ + | CI_SOLANO -- https://www.solanolabs.com/ + | CI_STRIDER -- https://strider-cd.github.io/ + | CI_TASKCLUSTER -- http://docs.taskcluster.net/ + | CI_TEAMCITY -- https://www.jetbrains.com/teamcity/ + | CI_TRAVIS -- http://travis-ci.org/ + | CI_UNKNOWN_VENDOR + deriving (Eq, Show, TH.Lift) + +$(Aeson.deriveJSON + Aeson.defaultOptions { Aeson.constructorTagModifier = drop $ T.length "CI_" } + ''CI) instance (TH.Lift k, TH.Lift v) => TH.Lift (HashMap k v) where - lift hashMap = [|HashMap.fromList $(TH.lift $ HashMap.toList hashMap)|] + lift hashMap = [|HashMap.fromList $(TH.lift $ HashMap.toList hashMap)|] newtype EnvVarName = EnvVarName { unEnvVarName :: Text } - deriving ( Eq, Hashable, Show, Aeson.FromJSON, Aeson.FromJSONKey - , Aeson.ToJSON, Aeson.ToJSONKey, TH.Lift ) + deriving (Eq, Hashable, Show, Aeson.FromJSON, Aeson.FromJSONKey, Aeson.ToJSON + , Aeson.ToJSONKey, TH.Lift) newtype EnvVarValue = EnvVarValue { unEnvVarValue :: Text } - deriving ( Eq, Show, Aeson.FromJSON, Aeson.ToJSON, TH.Lift ) + deriving (Eq, Show, Aeson.FromJSON, Aeson.ToJSON, TH.Lift) data VendorEnv = VendorEnvString !EnvVarName | VendorEnvList ![EnvVarName] | VendorEnvObject !(HashMap EnvVarName EnvVarValue) - deriving ( Eq, Show, TH.Lift ) + deriving (Eq, Show, TH.Lift) instance Aeson.FromJSON VendorEnv where - parseJSON val = case val of - Aeson.String _ -> VendorEnvString <$> Aeson.parseJSON val - Aeson.Array _ -> VendorEnvList <$> Aeson.parseJSON val - Aeson.Object _ -> VendorEnvObject <$> Aeson.parseJSON val - _ -> fail "expected String, List[String], or Map[String, String] in vendor env" + parseJSON val = case val of + Aeson.String _ -> VendorEnvString <$> Aeson.parseJSON val + Aeson.Array _ -> VendorEnvList <$> Aeson.parseJSON val + Aeson.Object _ -> VendorEnvObject <$> Aeson.parseJSON val + _ -> fail + "expected String, List[String], or Map[String, String] in vendor env" instance Aeson.ToJSON VendorEnv where - toJSON val = case val of - VendorEnvString key -> Aeson.toJSON key - VendorEnvList list -> Aeson.toJSON list - VendorEnvObject object -> Aeson.toJSON object + toJSON val = case val of + VendorEnvString key -> Aeson.toJSON key + VendorEnvList list -> Aeson.toJSON list + VendorEnvObject object -> Aeson.toJSON object newtype VendorName = VendorName { unVendorName :: Text } - deriving ( Eq, Show, Aeson.FromJSON, Aeson.ToJSON, TH.Lift ) + deriving (Eq, Show, Aeson.FromJSON, Aeson.ToJSON, TH.Lift) data Vendor = Vendor { vendorName :: !VendorName , vendorConstant :: !CI , vendorEnv :: !VendorEnv } - deriving ( Eq, Show, TH.Lift ) + deriving (Eq, Show, TH.Lift) $(Aeson.deriveJSON (Aeson.aesonPrefix Aeson.snakeCase) ''Vendor)