{-# LANGUAGE LambdaCase #-}
{-|
Description: Parse platform strings used by nixpkgs into Cabal's 'Platform'

This module defines conversions from the (autoconf-derived) platform strings
nixpkgs uses into Cabal's 'Platform' type. This is intended to facilitate later
evaluation of @.cabal@ files. For this conversion Cabal's 'Permissive'
heuristics are used as well as a logic equivalent to the @GHC_CONVERT_*@ macros
from GHC's configure script.

Since the process is inherently lossy because Cabal ignores certain factors like
endianness, conversion from 'Platform' to nixpkgs' platform strings. For this
usecase, try "Distribution.Nixpkgs.Meta" from @distribution-nixpkgs@.
-}
module Distribution.Nixpkgs.Haskell.Platform
  ( parsePlatformLenient
  , parsePlatformFromSystemLenient
  ) where

import Data.List ( isPrefixOf, intercalate )
import Data.List.Split ( splitOn )
import Data.Maybe ( fromMaybe, listToMaybe )
import Distribution.System

-- | Replicate the normalization performed by GHC_CONVERT_CPU in GHC's aclocal.m4
-- since the output of that is what Cabal parses.
ghcConvertArch :: String -> String
ghcConvertArch :: String -> String
ghcConvertArch String
arch = case String
arch of
  String
"i486"  -> String
"i386"
  String
"i586"  -> String
"i386"
  String
"i686"  -> String
"i386"
  String
"amd64" -> String
"x86_64"
  String
_ -> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
arch (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe
    [String
prefix | String
prefix <- [String]
archPrefixes, String
prefix String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
arch]
  where archPrefixes :: [String]
archPrefixes =
          [ String
"aarch64", String
"alpha", String
"arm", String
"hppa1_1", String
"hppa", String
"m68k", String
"mipseb"
          , String
"mipsel", String
"mips", String
"powerpc64le", String
"powerpc64", String
"powerpc", String
"s390x"
          , String
"sparc64", String
"sparc"
          ]

-- | Replicate the normalization performed by GHC_CONVERT_OS in GHC's aclocal.m4
-- since the output of that is what Cabal parses.
ghcConvertOS :: String -> String
ghcConvertOS :: String -> String
ghcConvertOS String
os = case String
os of
  String
"watchos"       -> String
"ios"
  String
"tvos"          -> String
"ios"
  String
"linux-android" -> String
"linux-android"
  String
"linux-androideabi" -> String
"linux-androideabi"
  String
_ | String
"linux-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
os -> String
"linux"
  String
_ -> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
os (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe
    [String
prefix | String
prefix <- [String]
osPrefixes, String
prefix String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
os]
  where osPrefixes :: [String]
osPrefixes =
          [ String
"gnu", String
"openbsd", String
"aix", String
"darwin", String
"solaris2", String
"freebsd", String
"nto-qnx"]

parseArch :: String -> Arch
parseArch :: String -> Arch
parseArch = ClassificationStrictness -> String -> Arch
classifyArch ClassificationStrictness
Permissive (String -> Arch) -> (String -> String) -> String -> Arch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
ghcConvertArch

parseOS :: String -> OS
parseOS :: String -> OS
parseOS = ClassificationStrictness -> String -> OS
classifyOS ClassificationStrictness
Permissive (String -> OS) -> (String -> String) -> String -> OS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
ghcConvertOS

parsePlatformParts :: [String] -> Maybe Platform
parsePlatformParts :: [String] -> Maybe Platform
parsePlatformParts = \case
  [String
arch, String
os] ->
    Platform -> Maybe Platform
forall a. a -> Maybe a
Just (Platform -> Maybe Platform) -> Platform -> Maybe Platform
forall a b. (a -> b) -> a -> b
$ Arch -> OS -> Platform
Platform (String -> Arch
parseArch String
arch) (String -> OS
parseOS String
os)
  (String
arch : String
_ : [String]
osParts) ->
    Platform -> Maybe Platform
forall a. a -> Maybe a
Just (Platform -> Maybe Platform) -> Platform -> Maybe Platform
forall a b. (a -> b) -> a -> b
$ Arch -> OS -> Platform
Platform (String -> Arch
parseArch String
arch) (OS -> Platform) -> OS -> Platform
forall a b. (a -> b) -> a -> b
$ String -> OS
parseOS (String -> OS) -> String -> OS
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"-" [String]
osParts
  [String]
_ -> Maybe Platform
forall a. Maybe a
Nothing

-- | Convert a platform string of two or three(-ish) components to 'Platform'.
--
--   For this, the following logic is utilized:
--
--   - If the string has one dash, the form @cpu-os@ is assumed where @os@ may
--     only have a single component. The @vendor@ part is ignored.
--
--   - Otherwise @cpu-vendor-os@ is assumed where @os@ may have any number of
--     components separated by dashes to accomodate its two component
--     @kernel-system@ form.
--
--   __Note:__ This behavior is different from nixpkgs' @lib.systems.elaborate@:
--   Because we have no knowledge of the legal contents of the different parts,
--   we only decide how to parse it based on what form the string has. This can
--   give different results compared to autoconf or nixpkgs. It will also never
--   reject an invalid platform string that has a valid form.
--
--   >>> parsePlatformLenient "x86_64-unknown-linux"
--   Just (Platform X86_64 Linux)
--   >>> parsePlatformLenient "x86_64-pc-linux-gnu"
--   Just (Platform X86_64 Linux)
--   >>> parsePlatformLenient "x86_64-linux"
--   Just (Platform X86_64 Linux)
--
--   __Note__ also that this conversion sometimes looses information nixpkgs
--   would retain:
--
--   >>> parsePlatformLenient "powerpc64-unknown-linux"
--   Just (Platform PPC64 Linux)
--   >>> parsePlatformLenient "powerpc64le-unknown-linux"
--   Just (Platform PPC64 Linux)
parsePlatformLenient :: String -> Maybe Platform
parsePlatformLenient :: String -> Maybe Platform
parsePlatformLenient = [String] -> Maybe Platform
parsePlatformParts ([String] -> Maybe Platform)
-> (String -> [String]) -> String -> Maybe Platform
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"-"

-- | Convert a Nix style system tuple into a Cabal 'Platform'. The tuple is
--   assumed to be of the form @cpu-os@, any extra components are assumed to be
--   part of @os@ to accomodate its @kernel-system@ form.
--
--   The same caveats about validation and lossiness apply as for
--   'parsePlatformLenient'.
--
--   >>> parsePlatformFromSystemLenient "x86_64-linux"
--   Just (Platform X86_64 Linux)
--   >>> parsePlatformFromSystemLenient "x86_64-linux-musl"
--   Just (Platform X86_64 Linux)
--   >>> parsePlatformFromSystemLenient "i686-netbsd"
--   Just (Platform I386 NetBSD)
parsePlatformFromSystemLenient :: String -> Maybe Platform
parsePlatformFromSystemLenient :: String -> Maybe Platform
parsePlatformFromSystemLenient String
s =
  case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') String
s of
    (String
arch, Char
'-':String
os) ->
      if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
arch Bool -> Bool -> Bool
|| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
os
      then Maybe Platform
forall a. Maybe a
Nothing
      else [String] -> Maybe Platform
parsePlatformParts [String
arch, String
os]
    (String, String)
_ -> Maybe Platform
forall a. Maybe a
Nothing