{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, RecordWildCards, LambdaCase, TypeApplications #-}
module Distribution.Nodejs.Package
(
LoggingPackage(..), decode
, Warning(..), formatWarning
, Package(..)
, Bin(..), Man(..), Dependencies
, parsePackageKeyName
) where
import Protolude hiding (packageName)
import Control.Monad (fail)
import qualified Control.Monad.Writer.Lazy as WL
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import qualified System.FilePath as FP
import Data.Aeson ((.:), (.:?), (.!=), Key)
import qualified Data.Aeson as A
import qualified Data.Aeson.Types as AT
import qualified Yarn.Lock.Types as YLT
import qualified Data.Aeson.Key as Key
import Data.Aeson.KeyMap (KeyMap)
import qualified Data.Aeson.KeyMap as KeyMap
data Package = Package
{ Package -> Text
name :: Text
, Package -> Text
version :: Text
, Package -> Maybe Text
description :: Maybe Text
, Package -> Maybe Text
homepage :: Maybe Text
, Package -> Bool
private :: Bool
, Package -> KeyMap Text
scripts :: KeyMap Text
, Package -> Bin
bin :: Bin
, Package -> Man
man :: Man
, Package -> Maybe Text
license :: Maybe Text
, Package -> KeyMap Text
dependencies :: Dependencies
, Package -> KeyMap Text
devDependencies :: Dependencies
} deriving (Int -> Package -> ShowS
[Package] -> ShowS
Package -> String
(Int -> Package -> ShowS)
-> (Package -> String) -> ([Package] -> ShowS) -> Show Package
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Package] -> ShowS
$cshowList :: [Package] -> ShowS
show :: Package -> String
$cshow :: Package -> String
showsPrec :: Int -> Package -> ShowS
$cshowsPrec :: Int -> Package -> ShowS
Show, Package -> Package -> Bool
(Package -> Package -> Bool)
-> (Package -> Package -> Bool) -> Eq Package
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Package -> Package -> Bool
$c/= :: Package -> Package -> Bool
== :: Package -> Package -> Bool
$c== :: Package -> Package -> Bool
Eq)
newtype LoggingPackage = LoggingPackage
{ LoggingPackage -> (Package, [Warning])
unLoggingPackage :: (Package, [Warning]) }
data Warning
= WrongType
{ Warning -> Text
wrongTypeField :: Text
, Warning -> Maybe Text
wrongTypeDefault :: Maybe Text
}
| PlainWarning Text
data Bin
= BinFiles (KeyMap FilePath)
| BinFolder FilePath
deriving (Int -> Bin -> ShowS
[Bin] -> ShowS
Bin -> String
(Int -> Bin -> ShowS)
-> (Bin -> String) -> ([Bin] -> ShowS) -> Show Bin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bin] -> ShowS
$cshowList :: [Bin] -> ShowS
show :: Bin -> String
$cshow :: Bin -> String
showsPrec :: Int -> Bin -> ShowS
$cshowsPrec :: Int -> Bin -> ShowS
Show, Bin -> Bin -> Bool
(Bin -> Bin -> Bool) -> (Bin -> Bin -> Bool) -> Eq Bin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bin -> Bin -> Bool
$c/= :: Bin -> Bin -> Bool
== :: Bin -> Bin -> Bool
$c== :: Bin -> Bin -> Bool
Eq)
data Man
= ManFiles (KeyMap FilePath)
deriving (Int -> Man -> ShowS
[Man] -> ShowS
Man -> String
(Int -> Man -> ShowS)
-> (Man -> String) -> ([Man] -> ShowS) -> Show Man
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Man] -> ShowS
$cshowList :: [Man] -> ShowS
show :: Man -> String
$cshow :: Man -> String
showsPrec :: Int -> Man -> ShowS
$cshowsPrec :: Int -> Man -> ShowS
Show, Man -> Man -> Bool
(Man -> Man -> Bool) -> (Man -> Man -> Bool) -> Eq Man
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Man -> Man -> Bool
$c/= :: Man -> Man -> Bool
== :: Man -> Man -> Bool
$c== :: Man -> Man -> Bool
Eq)
type Dependencies = KeyMap Text
type Warn = WL.WriterT [Warning] AT.Parser
putWarning :: a -> Warning -> Warn a
putWarning :: a -> Warning -> Warn a
putWarning a
a Warning
w = (a, [Warning]) -> Warn a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
WL.writer (a
a, [Warning
w])
instance A.FromJSON LoggingPackage where
parseJSON :: Value -> Parser LoggingPackage
parseJSON = String
-> (Object -> Parser LoggingPackage)
-> Value
-> Parser LoggingPackage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Package" ((Object -> Parser LoggingPackage)
-> Value -> Parser LoggingPackage)
-> (Object -> Parser LoggingPackage)
-> Value
-> Parser LoggingPackage
forall a b. (a -> b) -> a -> b
$ \Object
v -> ((Package, [Warning]) -> LoggingPackage)
-> Parser (Package, [Warning]) -> Parser LoggingPackage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Package, [Warning]) -> LoggingPackage
LoggingPackage (Parser (Package, [Warning]) -> Parser LoggingPackage)
-> (WriterT [Warning] Parser Package
-> Parser (Package, [Warning]))
-> WriterT [Warning] Parser Package
-> Parser LoggingPackage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT [Warning] Parser Package -> Parser (Package, [Warning])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
WL.runWriterT (WriterT [Warning] Parser Package -> Parser LoggingPackage)
-> WriterT [Warning] Parser Package -> Parser LoggingPackage
forall a b. (a -> b) -> a -> b
$ do
let
l :: AT.Parser a -> Warn a
l :: Parser a -> Warn a
l = Parser (a, [Warning]) -> Warn a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WL.WriterT (Parser (a, [Warning]) -> Warn a)
-> (Parser a -> Parser (a, [Warning])) -> Parser a -> Warn a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (a, [Warning])) -> Parser a -> Parser (a, [Warning])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> (a
a, []))
tryWarn :: (AT.FromJSON a, Show a)
=> AT.Key -> a -> Warn a
tryWarn :: Key -> a -> Warn a
tryWarn Key
field a
def =
Parser a -> Warn a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Object
v Object -> Key -> Parser (Maybe a)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
field Parser (Maybe a) -> a -> Parser a
forall a. Parser (Maybe a) -> a -> Parser a
.!= a
def)
Warn a -> Warn a -> Warn a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> Warning -> Warn a
forall a. a -> Warning -> Warn a
putWarning a
def (WrongType :: Text -> Maybe Text -> Warning
WrongType { wrongTypeField :: Text
wrongTypeField = Key
field Key -> (Key -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Key -> Text
Key.toText
, wrongTypeDefault :: Maybe Text
wrongTypeDefault = Text -> Maybe Text
forall a. a -> Maybe a
Just (a -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show a
def) })
Text
name <- Parser Text -> Warn Text
forall a. Parser a -> Warn a
l (Parser Text -> Warn Text) -> Parser Text -> Warn Text
forall a b. (a -> b) -> a -> b
$ Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
Text
version <- Parser Text -> Warn Text
forall a. Parser a -> Warn a
l (Parser Text -> Warn Text) -> Parser Text -> Warn Text
forall a b. (a -> b) -> a -> b
$ Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
Maybe Text
description <- Key -> Maybe Text -> Warn (Maybe Text)
forall a. (FromJSON a, Show a) => Key -> a -> Warn a
tryWarn Key
"description" Maybe Text
forall a. Maybe a
Nothing
Maybe Text
homepage <- Key -> Maybe Text -> Warn (Maybe Text)
forall a. (FromJSON a, Show a) => Key -> a -> Warn a
tryWarn Key
"homepage" Maybe Text
forall a. Maybe a
Nothing
Bool
private <- Key -> Bool -> Warn Bool
forall a. (FromJSON a, Show a) => Key -> a -> Warn a
tryWarn Key
"private" Bool
False
KeyMap Text
scripts <- (Text -> Object -> Warn (KeyMap Text)
parseMapText Text
"scripts" (Object -> Warn (KeyMap Text))
-> WriterT [Warning] Parser Object -> Warn (KeyMap Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Key -> Object -> WriterT [Warning] Parser Object
forall a. (FromJSON a, Show a) => Key -> a -> Warn a
tryWarn Key
"scripts" Object
forall a. Monoid a => a
mempty))
Bin
bin <- Text -> Object -> Warn Bin
parseBin Text
name Object
v
Man
man <- Parser Man -> Warn Man
forall a. Parser a -> Warn a
l (Parser Man -> Warn Man) -> Parser Man -> Warn Man
forall a b. (a -> b) -> a -> b
$ Text -> Object -> Parser Man
parseMan Text
name Object
v
Maybe Text
license <- Key -> Maybe Text -> Warn (Maybe Text)
forall a. (FromJSON a, Show a) => Key -> a -> Warn a
tryWarn Key
"license" Maybe Text
forall a. Maybe a
Nothing
KeyMap Text
dependencies <- Key -> Value -> Warn Value
forall a. (FromJSON a, Show a) => Key -> a -> Warn a
tryWarn Key
"dependencies" (Object -> Value
AT.Object Object
forall a. Monoid a => a
mempty)
Warn Value -> (Value -> Warn (KeyMap Text)) -> Warn (KeyMap Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Value -> Warn (KeyMap Text)
parseDependencies Text
"dependencies"
KeyMap Text
devDependencies <- Key -> Value -> Warn Value
forall a. (FromJSON a, Show a) => Key -> a -> Warn a
tryWarn Key
"devDependencies" (Object -> Value
AT.Object Object
forall a. Monoid a => a
mempty)
Warn Value -> (Value -> Warn (KeyMap Text)) -> Warn (KeyMap Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Value -> Warn (KeyMap Text)
parseDependencies Text
"devDependencies"
Package -> WriterT [Warning] Parser Package
forall (f :: * -> *) a. Applicative f => a -> f a
pure Package :: Text
-> Text
-> Maybe Text
-> Maybe Text
-> Bool
-> KeyMap Text
-> Bin
-> Man
-> Maybe Text
-> KeyMap Text
-> KeyMap Text
-> Package
Package{Bool
Maybe Text
Text
KeyMap Text
Man
Bin
devDependencies :: KeyMap Text
dependencies :: KeyMap Text
license :: Maybe Text
man :: Man
bin :: Bin
scripts :: KeyMap Text
private :: Bool
homepage :: Maybe Text
description :: Maybe Text
version :: Text
name :: Text
devDependencies :: KeyMap Text
dependencies :: KeyMap Text
license :: Maybe Text
man :: Man
bin :: Bin
scripts :: KeyMap Text
private :: Bool
homepage :: Maybe Text
description :: Maybe Text
version :: Text
name :: Text
..}
where
parseDependencies :: Text -> AT.Value -> Warn Dependencies
parseDependencies :: Text -> Value -> Warn (KeyMap Text)
parseDependencies Text
field Value
v =
let
warn :: Warn (KeyMap Text)
warn = KeyMap Text -> Warning -> Warn (KeyMap Text)
forall a. a -> Warning -> Warn a
putWarning KeyMap Text
forall a. Monoid a => a
mempty
(Warning -> Warn (KeyMap Text)) -> Warning -> Warn (KeyMap Text)
forall a b. (a -> b) -> a -> b
$ WrongType :: Text -> Maybe Text -> Warning
WrongType
{ wrongTypeField :: Text
wrongTypeField = Text
field
, wrongTypeDefault :: Maybe Text
wrongTypeDefault = Text -> Maybe Text
forall a. a -> Maybe a
Just (KeyMap Text -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (KeyMap Text
forall a. Monoid a => a
mempty :: Dependencies)) }
in case Value
v of
AT.Array Array
a ->
if Array -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Array
a then Warn (KeyMap Text)
warn
else String -> Warn (KeyMap Text)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
(String -> Warn (KeyMap Text)) -> String -> Warn (KeyMap Text)
forall a b. (a -> b) -> a -> b
$ String
"\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
field String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" is a non empty array instead of a JSON object"
AT.Object Object
deps -> Parser (KeyMap Text) -> Warn (KeyMap Text)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser (KeyMap Text) -> Warn (KeyMap Text))
-> Parser (KeyMap Text) -> Warn (KeyMap Text)
forall a b. (a -> b) -> a -> b
$ (Value -> Parser Text) -> Object -> Parser (KeyMap Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (FromJSON Text => Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON @Text) Object
deps
Value
_ -> Warn (KeyMap Text)
warn
parseMapText :: Text -> KeyMap AT.Value
-> Warn (KeyMap Text)
parseMapText :: Text -> Object -> Warn (KeyMap Text)
parseMapText Text
fieldPath Object
val =
(Maybe Text -> Maybe Text) -> KeyMap (Maybe Text) -> KeyMap Text
forall a b. (a -> Maybe b) -> KeyMap a -> KeyMap b
KeyMap.mapMaybe Maybe Text -> Maybe Text
forall a. a -> a
identity (KeyMap (Maybe Text) -> KeyMap Text)
-> WriterT [Warning] Parser (KeyMap (Maybe Text))
-> Warn (KeyMap Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Key -> Value -> Warn (Maybe Text))
-> Object -> WriterT [Warning] Parser (KeyMap (Maybe Text))
forall (f :: * -> *) v1 v2.
Applicative f =>
(Key -> v1 -> f v2) -> KeyMap v1 -> f (KeyMap v2)
KeyMap.traverseWithKey Key -> Value -> Warn (Maybe Text)
tryParse Object
val
where
tryParse :: A.Key -> A.Value -> Warn (Maybe Text)
tryParse :: Key -> Value -> Warn (Maybe Text)
tryParse Key
key Value
el = Parser (Maybe Text) -> Warn (Maybe Text)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
AT.parseJSON Value
el)
Warn (Maybe Text) -> Warn (Maybe Text) -> Warn (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text -> Warning -> Warn (Maybe Text)
forall a. a -> Warning -> Warn a
putWarning Maybe Text
forall a. Maybe a
Nothing
(WrongType :: Text -> Maybe Text -> Warning
WrongType { wrongTypeField :: Text
wrongTypeField = Text
fieldPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Key
key Key -> (Key -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Key -> Text
Key.toText)
, wrongTypeDefault :: Maybe Text
wrongTypeDefault = Maybe Text
forall a. Maybe a
Nothing })
parseBin :: Text -> AT.Object -> Warn Bin
parseBin :: Text -> Object -> Warn Bin
parseBin Text
packageName Object
v = do
Maybe Value
binVal <- Parser (Maybe Value) -> WriterT [Warning] Parser (Maybe Value)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser (Maybe Value) -> WriterT [Warning] Parser (Maybe Value))
-> Parser (Maybe Value) -> WriterT [Warning] Parser (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Parser Value -> Parser (Maybe Value)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Value -> Parser (Maybe Value))
-> Parser Value -> Parser (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Object
v Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bin"
Maybe Value
dirBinVal <- Parser (Maybe Value) -> WriterT [Warning] Parser (Maybe Value)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser (Maybe Value) -> WriterT [Warning] Parser (Maybe Value))
-> Parser (Maybe Value) -> WriterT [Warning] Parser (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Parser Value -> Parser (Maybe Value)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Value -> Parser (Maybe Value))
-> Parser Value -> Parser (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Object
v Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"directories" Parser Object -> (Object -> Parser Value) -> Parser Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bin")
case (Maybe Value
binVal, Maybe Value
dirBinVal) of
(Just Value
_ , Just Value
_) ->
Bin -> Warning -> Warn Bin
forall a. a -> Warning -> Warn a
putWarning (KeyMap String -> Bin
BinFiles KeyMap String
forall a. Monoid a => a
mempty) (Warning -> Warn Bin) -> Warning -> Warn Bin
forall a b. (a -> b) -> a -> b
$ Text -> Warning
PlainWarning
Text
"`bin` and `directories.bin` must not exist at the same time, skipping."
(Just (A.String Text
path), Maybe Value
_) -> Bin -> Warn Bin
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bin -> Warn Bin) -> Bin -> Warn Bin
forall a b. (a -> b) -> a -> b
$ KeyMap String -> Bin
BinFiles
(KeyMap String -> Bin) -> KeyMap String -> Bin
forall a b. (a -> b) -> a -> b
$ Key -> String -> KeyMap String
forall v. Key -> v -> KeyMap v
KeyMap.singleton (Text -> Text
parsePackageName Text
packageName Text -> (Text -> Key) -> Key
forall a b. a -> (a -> b) -> b
& Text -> Key
Key.fromText) (Text -> String
forall a b. ConvertText a b => a -> b
toS Text
path)
(Just (A.Object Object
bins), Maybe Value
_) -> Parser Bin -> Warn Bin
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Bin -> Warn Bin) -> Parser Bin -> Warn Bin
forall a b. (a -> b) -> a -> b
$ KeyMap String -> Bin
BinFiles
(KeyMap String -> Bin) -> Parser (KeyMap String) -> Parser Bin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser String) -> Object -> Parser (KeyMap String)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (String -> (Text -> Parser String) -> Value -> Parser String
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"BinPath" (String -> Parser String
forall (f :: * -> *) a. Applicative f => a -> f a
pure(String -> Parser String)
-> (Text -> String) -> Text -> Parser String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Text -> String
forall a b. ConvertText a b => a -> b
toS)) Object
bins
(Just Value
_ , Maybe Value
_) -> String -> Warn Bin
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
(String -> Warn Bin) -> String -> Warn Bin
forall a b. (a -> b) -> a -> b
$ String
"`bin` must be a path or a map of names to paths."
(Maybe Value
_ , Just (A.String Text
path)) -> Bin -> Warn Bin
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bin -> Warn Bin) -> Bin -> Warn Bin
forall a b. (a -> b) -> a -> b
$ String -> Bin
BinFolder (String -> Bin) -> String -> Bin
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a b. ConvertText a b => a -> b
toS Text
path
(Maybe Value
_ , Just Value
_) -> String -> Warn Bin
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
(String -> Warn Bin) -> String -> Warn Bin
forall a b. (a -> b) -> a -> b
$ String
"`directories.bin` must be a path."
(Maybe Value
Nothing , Maybe Value
Nothing) -> Bin -> Warn Bin
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bin -> Warn Bin)
-> (KeyMap String -> Bin) -> KeyMap String -> Warn Bin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap String -> Bin
BinFiles (KeyMap String -> Warn Bin) -> KeyMap String -> Warn Bin
forall a b. (a -> b) -> a -> b
$ KeyMap String
forall a. Monoid a => a
mempty
parseMan :: Text -> Object -> Parser Man
parseMan Text
name Object
v = do
let getMan :: (a -> KeyMap String) -> Parser Man
getMan a -> KeyMap String
f = KeyMap String -> Man
ManFiles (KeyMap String -> Man) -> (a -> KeyMap String) -> a -> Man
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> KeyMap String
f (a -> Man) -> Parser a -> Parser Man
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"man"
extractName :: FilePath -> (Key, FilePath)
extractName :: String -> (Key, String)
extractName String
file =
let f :: Text
f = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
FP.takeFileName String
file
in if Text
name Text -> Text -> Bool
`T.isPrefixOf` Text
f
then (Text -> Key
Key.fromText Text
name, String
file)
else (Text -> Key
Key.fromText (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f, String
file)
(([String] -> KeyMap String) -> Parser Man
forall a. FromJSON a => (a -> KeyMap String) -> Parser Man
getMan ([(Key, String)] -> KeyMap String
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList ([(Key, String)] -> KeyMap String)
-> ([String] -> [(Key, String)]) -> [String] -> KeyMap String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> (Key, String)) -> [String] -> [(Key, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map String -> (Key, String)
extractName)
Parser Man -> Parser Man -> Parser Man
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> KeyMap String) -> Parser Man
forall a. FromJSON a => (a -> KeyMap String) -> Parser Man
getMan ([(Key, String)] -> KeyMap String
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList ([(Key, String)] -> KeyMap String)
-> (String -> [(Key, String)]) -> String -> KeyMap String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Key, String) -> [(Key, String)] -> [(Key, String)]
forall a. a -> [a] -> [a]
:[]) ((Key, String) -> [(Key, String)])
-> (String -> (Key, String)) -> String -> [(Key, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Key, String)
extractName)
Parser Man -> Parser Man -> Parser Man
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Man -> Parser Man
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyMap String -> Man
ManFiles KeyMap String
forall a. Monoid a => a
mempty))
decode :: BL.ByteString -> Either Text LoggingPackage
decode :: ByteString -> Either Text LoggingPackage
decode = (String -> Text)
-> Either String LoggingPackage -> Either Text LoggingPackage
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
forall a b. ConvertText a b => a -> b
toS (Either String LoggingPackage -> Either Text LoggingPackage)
-> (ByteString -> Either String LoggingPackage)
-> ByteString
-> Either Text LoggingPackage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String LoggingPackage
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode
formatWarning :: Warning -> Text
formatWarning :: Warning -> Text
formatWarning = \case
WrongType{Maybe Text
Text
wrongTypeDefault :: Maybe Text
wrongTypeField :: Text
wrongTypeDefault :: Warning -> Maybe Text
wrongTypeField :: Warning -> Text
..} ->
Text
"Field \""
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
wrongTypeField
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" has the wrong type. "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (case Maybe Text
wrongTypeDefault of
Just Text
def -> Text
"Defaulting to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
def
Maybe Text
Nothing -> Text
"Leaving it out")
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
(PlainWarning Text
t) -> Text
t
parsePackageKeyName :: Text -> YLT.PackageKeyName
parsePackageKeyName :: Text -> PackageKeyName
parsePackageKeyName Text
k =
case Text -> Maybe PackageKeyName
YLT.parsePackageKeyName Text
k of
Maybe PackageKeyName
Nothing -> (Text -> PackageKeyName
YLT.SimplePackageKey Text
k)
Just PackageKeyName
pkn -> PackageKeyName
pkn
parsePackageName :: Text -> Text
parsePackageName :: Text -> Text
parsePackageName Text
k =
case Text -> PackageKeyName
parsePackageKeyName Text
k of
YLT.SimplePackageKey Text
n -> Text
n
YLT.ScopedPackageKey Text
_ Text
n -> Text
n