{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
module Language.Ninja.IR.Meta
(
Meta, makeMeta, metaReqVersion, metaBuildDir
) where
import Data.Aeson ((.:), (.=))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import Data.Text (Text)
import Control.DeepSeq (NFData)
import Data.Hashable (Hashable)
import GHC.Generics (Generic)
import qualified Test.SmallCheck.Series as SC
import qualified Data.Versions as Ver
import qualified Text.Megaparsec as Mega
import Language.Ninja.Misc.Path (Path)
import qualified Control.Lens as Lens
import Flow ((.>), (|>))
data Meta
= MkMeta
{ _metaReqVersion :: !(Maybe Ver.Version)
, _metaBuildDir :: !(Maybe Path)
}
deriving (Eq, Ord, Show, Generic)
{-# INLINE makeMeta #-}
makeMeta :: Meta
makeMeta = MkMeta
{ _metaReqVersion = Nothing
, _metaBuildDir = Nothing
}
{-# INLINE metaReqVersion #-}
metaReqVersion :: Lens.Lens' Meta (Maybe Ver.Version)
metaReqVersion = Lens.lens _metaReqVersion
$ \(MkMeta {..}) x -> MkMeta { _metaReqVersion = x, .. }
{-# INLINE metaBuildDir #-}
metaBuildDir :: Lens.Lens' Meta (Maybe Path)
metaBuildDir = Lens.lens _metaBuildDir
$ \(MkMeta {..}) x -> MkMeta { _metaBuildDir = x, .. }
instance Aeson.ToJSON Meta where
toJSON (MkMeta {..})
= [ "req-version" .= fmap versionJ _metaReqVersion
, "build-dir" .= _metaBuildDir
] |> Aeson.object
where
versionJ :: Ver.Version -> Aeson.Value
versionJ = Ver.prettyVer .> Aeson.toJSON
instance Aeson.FromJSON Meta where
parseJSON = (Aeson.withObject "Meta" $ \o -> do
_metaReqVersion <- (o .: "req-version") >>= maybeVersionP
_metaBuildDir <- (o .: "build-dir") >>= pure
pure (MkMeta {..}))
where
maybeVersionP :: Maybe Aeson.Value -> Aeson.Parser (Maybe Ver.Version)
maybeVersionP = fmap versionP .> sequenceA
versionP :: Aeson.Value -> Aeson.Parser Ver.Version
versionP = Aeson.withText "Version" (megaparsecToAeson Ver.version')
instance Hashable Meta
instance NFData Meta
instance ( Monad m
, SC.Serial m Ver.Version
, SC.Serial m Text
) => SC.Serial m Meta
instance ( Monad m
, SC.CoSerial m Ver.Version
, SC.CoSerial m Text
) => SC.CoSerial m Meta
megaparsecToAeson :: Mega.Parsec Mega.Dec Text t
-> (Text -> Aeson.Parser t)
megaparsecToAeson parser text = case Mega.runParser parser "" text of
Left e -> fail (Mega.parseErrorPretty e)
Right x -> pure x