module CabalGild.Unstable.Type.Variable where

import qualified CabalGild.Unstable.Extra.CharParsing as Parse
import qualified CabalGild.Unstable.Type.VersionRange as VersionRange
import qualified Data.Char as Char
import qualified Distribution.Compat.CharParsing as Parse
import qualified Distribution.Compiler as Compiler
import qualified Distribution.Parsec as Parsec
import qualified Distribution.Pretty as Pretty
import qualified Distribution.System as System
import qualified Distribution.Types.Flag as Flag
import qualified Text.PrettyPrint as PrettyPrint

-- | Similar to 'Distribution.Types.ConfVar.ConfVar', but with different
-- parsing and pretty-printing behavior.
data Variable
  = Arch System.Arch
  | Flag Flag.FlagName
  | Impl Compiler.CompilerFlavor (Maybe VersionRange.VersionRange)
  | Os System.OS
  deriving (Variable -> Variable -> Bool
(Variable -> Variable -> Bool)
-> (Variable -> Variable -> Bool) -> Eq Variable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Variable -> Variable -> Bool
== :: Variable -> Variable -> Bool
$c/= :: Variable -> Variable -> Bool
/= :: Variable -> Variable -> Bool
Eq, Int -> Variable -> ShowS
[Variable] -> ShowS
Variable -> String
(Int -> Variable -> ShowS)
-> (Variable -> String) -> ([Variable] -> ShowS) -> Show Variable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Variable -> ShowS
showsPrec :: Int -> Variable -> ShowS
$cshow :: Variable -> String
show :: Variable -> String
$cshowList :: [Variable] -> ShowS
showList :: [Variable] -> ShowS
Show)

-- | Parses a 'Variable'. This is generally as permissive as possible.
parseVariable :: (Parsec.CabalParsing m) => m Variable
parseVariable :: forall (m :: * -> *). CabalParsing m => m Variable
parseVariable =
  [m Variable] -> m Variable
forall (m :: * -> *) a. Alternative m => [m a] -> m a
Parse.choice
    [ Arch -> Variable
Arch (Arch -> Variable) -> m Arch -> m Variable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Arch
forall (m :: * -> *). CabalParsing m => m Arch
parseArch,
      FlagName -> Variable
Flag (FlagName -> Variable) -> m FlagName -> m Variable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m FlagName
forall (m :: * -> *). CabalParsing m => m FlagName
parseFlag,
      (CompilerFlavor -> Maybe VersionRange -> Variable)
-> (CompilerFlavor, Maybe VersionRange) -> Variable
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry CompilerFlavor -> Maybe VersionRange -> Variable
Impl ((CompilerFlavor, Maybe VersionRange) -> Variable)
-> m (CompilerFlavor, Maybe VersionRange) -> m Variable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (CompilerFlavor, Maybe VersionRange)
forall (m :: * -> *).
CabalParsing m =>
m (CompilerFlavor, Maybe VersionRange)
parseImpl,
      OS -> Variable
Os (OS -> Variable) -> m OS -> m Variable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m OS
forall (m :: * -> *). CabalParsing m => m OS
parseOs
    ]

-- | Parses an 'Arch'.
parseArch :: (Parsec.CabalParsing m) => m System.Arch
parseArch :: forall (m :: * -> *). CabalParsing m => m Arch
parseArch =
  (String -> Arch) -> m String -> m Arch
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ClassificationStrictness -> String -> Arch
System.classifyArch ClassificationStrictness
System.Permissive) (m String -> m Arch) -> m String -> m Arch
forall a b. (a -> b) -> a -> b
$
    String -> m ()
forall (m :: * -> *). CabalParsing m => String -> m ()
Parse.token String
"arch" m () -> m String -> m String
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m String -> m String
forall (m :: * -> *) a. CabalParsing m => m a -> m a
Parse.parens m String
forall (m :: * -> *). CabalParsing m => m String
parseIdent

-- | Parses a 'Flag'.
parseFlag :: (Parsec.CabalParsing m) => m Flag.FlagName
parseFlag :: forall (m :: * -> *). CabalParsing m => m FlagName
parseFlag = String -> m ()
forall (m :: * -> *). CabalParsing m => String -> m ()
Parse.token String
"flag" m () -> m FlagName -> m FlagName
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m FlagName -> m FlagName
forall (m :: * -> *) a. CabalParsing m => m a -> m a
Parse.parens (m FlagName
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m FlagName
Parsec.parsec m FlagName -> m () -> m FlagName
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall (m :: * -> *). CharParsing m => m ()
Parse.spaces)

-- | Parses an 'Impl'.
parseImpl :: (Parsec.CabalParsing m) => m (Compiler.CompilerFlavor, Maybe VersionRange.VersionRange)
parseImpl :: forall (m :: * -> *).
CabalParsing m =>
m (CompilerFlavor, Maybe VersionRange)
parseImpl = do
  String -> m ()
forall (m :: * -> *). CabalParsing m => String -> m ()
Parse.token String
"impl"
  m (CompilerFlavor, Maybe VersionRange)
-> m (CompilerFlavor, Maybe VersionRange)
forall (m :: * -> *) a. CabalParsing m => m a -> m a
Parse.parens (m (CompilerFlavor, Maybe VersionRange)
 -> m (CompilerFlavor, Maybe VersionRange))
-> m (CompilerFlavor, Maybe VersionRange)
-> m (CompilerFlavor, Maybe VersionRange)
forall a b. (a -> b) -> a -> b
$
    (,)
      (CompilerFlavor
 -> Maybe VersionRange -> (CompilerFlavor, Maybe VersionRange))
-> m CompilerFlavor
-> m (Maybe VersionRange -> (CompilerFlavor, Maybe VersionRange))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m CompilerFlavor
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m CompilerFlavor
Parsec.parsec
      m (Maybe VersionRange -> (CompilerFlavor, Maybe VersionRange))
-> m ()
-> m (Maybe VersionRange -> (CompilerFlavor, Maybe VersionRange))
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall (m :: * -> *). CharParsing m => m ()
Parse.spaces
      m (Maybe VersionRange -> (CompilerFlavor, Maybe VersionRange))
-> m (Maybe VersionRange) -> m (CompilerFlavor, Maybe VersionRange)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m VersionRange -> m (Maybe VersionRange)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Parse.optional m VersionRange
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m VersionRange
Parsec.parsec
      m (CompilerFlavor, Maybe VersionRange)
-> m () -> m (CompilerFlavor, Maybe VersionRange)
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall (m :: * -> *). CharParsing m => m ()
Parse.spaces

-- | Parses an 'Os'.
parseOs :: (Parsec.CabalParsing m) => m System.OS
parseOs :: forall (m :: * -> *). CabalParsing m => m OS
parseOs =
  (String -> OS) -> m String -> m OS
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ClassificationStrictness -> String -> OS
System.classifyOS ClassificationStrictness
System.Permissive) (m String -> m OS) -> m String -> m OS
forall a b. (a -> b) -> a -> b
$
    String -> m ()
forall (m :: * -> *). CabalParsing m => String -> m ()
Parse.token String
"os" m () -> m String -> m String
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m String -> m String
forall (m :: * -> *) a. CabalParsing m => m a -> m a
Parse.parens m String
forall (m :: * -> *). CabalParsing m => m String
parseIdent

-- | Parses an identifier. This is more permissive than anything provided by
-- Cabal. Any run of alphanumeric characters, underscores, or hyphens is
-- considered an identifier.
parseIdent :: (Parsec.CabalParsing m) => m String
parseIdent :: forall (m :: * -> *). CabalParsing m => m String
parseIdent =
  let isIdent :: Char -> Bool
isIdent Char
c = Char -> Bool
Char.isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'
   in (Char -> Bool) -> m String
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
Parse.munch1 Char -> Bool
isIdent m String -> m () -> m String
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall (m :: * -> *). CharParsing m => m ()
Parse.spaces

-- | Pretty-prints a 'Variable'.
prettyVariable :: Variable -> PrettyPrint.Doc
prettyVariable :: Variable -> Doc
prettyVariable Variable
x =
  case Variable
x of
    Arch Arch
y ->
      String -> Doc
PrettyPrint.text String
"arch"
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
PrettyPrint.parens (Arch -> Doc
forall a. Pretty a => a -> Doc
Pretty.pretty Arch
y)
    Flag FlagName
y ->
      String -> Doc
PrettyPrint.text String
"flag"
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
PrettyPrint.parens (FlagName -> Doc
forall a. Pretty a => a -> Doc
Pretty.pretty FlagName
y)
    Impl CompilerFlavor
y Maybe VersionRange
z ->
      String -> Doc
PrettyPrint.text String
"impl"
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
PrettyPrint.parens (CompilerFlavor -> Doc
forall a. Pretty a => a -> Doc
Pretty.pretty CompilerFlavor
y Doc -> Doc -> Doc
PrettyPrint.<+> (VersionRange -> Doc) -> Maybe VersionRange -> Doc
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap VersionRange -> Doc
forall a. Pretty a => a -> Doc
Pretty.pretty Maybe VersionRange
z)
    Os OS
y ->
      String -> Doc
PrettyPrint.text String
"os"
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
PrettyPrint.parens (OS -> Doc
forall a. Pretty a => a -> Doc
Pretty.pretty OS
y)