{-# OPTIONS_GHC -fno-warn-orphans #-}

module Distribution.Nixpkgs.Haskell.OrphanInstances ( ) where

import Control.DeepSeq
import Data.Maybe
import Data.String
import qualified Data.Text as T
import Data.Yaml
import Distribution.Compiler
import Distribution.Package
import Distribution.Parsec
import Distribution.System
import Distribution.Pretty as Cabal
import qualified Data.Version as Base
import Distribution.Version
import Language.Nix.PrettyPrinting as Nix

instance NFData CompilerInfo
instance NFData AbiTag

instance IsString Version where
  fromString :: String -> Version
fromString = String -> String -> Version
forall a. Parsec a => String -> String -> a
text2isString String
"Version"

instance IsString VersionRange where
  fromString :: String -> VersionRange
fromString = String -> String -> VersionRange
forall a. Parsec a => String -> String -> a
text2isString String
"VersionRange"

instance IsString PackageIdentifier where
  fromString :: String -> PackageIdentifier
fromString = String -> String -> PackageIdentifier
forall a. Parsec a => String -> String -> a
text2isString String
"PackageIdentifier"

instance IsString Dependency where
  fromString :: String -> Dependency
fromString = String -> String -> Dependency
forall a. Parsec a => String -> String -> a
text2isString String
"Dependency"

instance IsString CompilerId where
  fromString :: String -> CompilerId
fromString = String -> String -> CompilerId
forall a. Parsec a => String -> String -> a
text2isString String
"CompilerId"

instance IsString Platform where
  fromString :: String -> Platform
fromString String
"i686-linux" = Arch -> OS -> Platform
Platform Arch
I386 OS
Linux
  fromString String
"x86_64-linux" = Arch -> OS -> Platform
Platform Arch
X86_64 OS
Linux
  fromString String
"x86_64-darwin" = Arch -> OS -> Platform
Platform Arch
X86_64 OS
OSX
  fromString String
s = String -> Platform
forall a. HasCallStack => String -> a
error (String
"fromString: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not a valid platform")

instance FromJSON Platform where
  parseJSON :: Value -> Parser Platform
parseJSON (String Text
s) = Platform -> Parser Platform
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Platform
forall a. IsString a => String -> a
fromString (Text -> String
T.unpack Text
s))
  parseJSON Value
s = String -> Parser Platform
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"parseJSON: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not a valid platform")

instance FromJSON PackageName where
  parseJSON :: Value -> Parser PackageName
parseJSON (String Text
s) = PackageName -> Parser PackageName
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PackageName
forall a. IsString a => String -> a
fromString (Text -> String
T.unpack Text
s))
  parseJSON Value
s = String -> Parser PackageName
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"parseJSON: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not a valid Haskell package name")

instance FromJSON PackageIdentifier where
  parseJSON :: Value -> Parser PackageIdentifier
parseJSON (String Text
s) = PackageIdentifier -> Parser PackageIdentifier
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PackageIdentifier
forall a. IsString a => String -> a
fromString (Text -> String
T.unpack Text
s))
  parseJSON Value
s = String -> Parser PackageIdentifier
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"parseJSON: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not a valid Haskell package identifier")

instance FromJSON VersionRange where
  parseJSON :: Value -> Parser VersionRange
parseJSON (String Text
s) = VersionRange -> Parser VersionRange
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> VersionRange
forall a. IsString a => String -> a
fromString (Text -> String
T.unpack Text
s))
  parseJSON Value
s = String -> Parser VersionRange
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"parseJSON: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not a valid Cabal VersionRange")

instance FromJSON Dependency where
  parseJSON :: Value -> Parser Dependency
parseJSON (String Text
s) = Dependency -> Parser Dependency
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Dependency
forall a. IsString a => String -> a
fromString (Text -> String
T.unpack Text
s))
  parseJSON Value
s = String -> Parser Dependency
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"parseJSON: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not a valid Haskell Dependency")

instance FromJSON CompilerInfo where
  parseJSON :: Value -> Parser CompilerInfo
parseJSON (String Text
s) = CompilerInfo -> Parser CompilerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (CompilerId -> AbiTag -> CompilerInfo
unknownCompilerInfo (String -> CompilerId
forall a. IsString a => String -> a
fromString (Text -> String
T.unpack Text
s)) AbiTag
NoAbiTag)
  parseJSON Value
s = String -> Parser CompilerInfo
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"parseJSON: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not a valid Haskell compiler")

instance Nix.Pretty Version where
  pPrint :: Version -> Doc
pPrint = Version -> Doc
forall a. Pretty a => a -> Doc
pretty

instance Nix.Pretty PackageName where
  pPrint :: PackageName -> Doc
pPrint = PackageName -> Doc
forall a. Pretty a => a -> Doc
pretty

instance Nix.Pretty PackageIdentifier where
  pPrint :: PackageIdentifier -> Doc
pPrint = PackageIdentifier -> Doc
forall a. Pretty a => a -> Doc
pretty

instance Nix.Pretty CompilerId where
  pPrint :: CompilerId -> Doc
pPrint = CompilerId -> Doc
forall a. Pretty a => a -> Doc
pretty

instance Nix.Pretty Platform where
  pPrint :: Platform -> Doc
pPrint = Platform -> Doc
forall a. Pretty a => a -> Doc
pretty

instance Nix.Pretty Base.Version where
  pPrint :: Version -> Doc
pPrint = String -> Doc
text (String -> Doc) -> (Version -> String) -> Version -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
Base.showVersion

-- parsing tools

text2isString :: Parsec a => String -> String -> a
text2isString :: String -> String -> a
text2isString String
t String
s = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (String -> a
forall a. HasCallStack => String -> a
error (String
"fromString: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not a valid " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t)) (String -> Maybe a
forall a. Parsec a => String -> Maybe a
simpleParsec String
s)