module CabalGild.Unstable.Type.Variable where

import qualified CabalGild.Unstable.Extra.CharParsing as Parse
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 Distribution.Types.VersionRange as VersionRange
import qualified Text.PrettyPrint as PrettyPrint

data Variable
  = Arch System.Arch
  | Flag Flag.FlagName
  | Impl Compiler.CompilerFlavor 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)

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 -> VersionRange -> Variable)
-> (CompilerFlavor, VersionRange) -> Variable
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry CompilerFlavor -> VersionRange -> Variable
Impl ((CompilerFlavor, VersionRange) -> Variable)
-> m (CompilerFlavor, VersionRange) -> m Variable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (CompilerFlavor, VersionRange)
forall (m :: * -> *).
CabalParsing m =>
m (CompilerFlavor, 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
    ]

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

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)

parseImpl :: (Parsec.CabalParsing m) => m (Compiler.CompilerFlavor, VersionRange.VersionRange)
parseImpl :: forall (m :: * -> *).
CabalParsing m =>
m (CompilerFlavor, VersionRange)
parseImpl = do
  String -> m ()
forall (m :: * -> *). CabalParsing m => String -> m ()
Parse.token String
"impl"
  m (CompilerFlavor, VersionRange)
-> m (CompilerFlavor, VersionRange)
forall (m :: * -> *) a. CabalParsing m => m a -> m a
Parse.parens (m (CompilerFlavor, VersionRange)
 -> m (CompilerFlavor, VersionRange))
-> m (CompilerFlavor, VersionRange)
-> m (CompilerFlavor, VersionRange)
forall a b. (a -> b) -> a -> b
$
    (,)
      (CompilerFlavor -> VersionRange -> (CompilerFlavor, VersionRange))
-> m CompilerFlavor
-> m (VersionRange -> (CompilerFlavor, 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 (VersionRange -> (CompilerFlavor, VersionRange))
-> m () -> m (VersionRange -> (CompilerFlavor, 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 (VersionRange -> (CompilerFlavor, VersionRange))
-> m VersionRange -> m (CompilerFlavor, VersionRange)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> VersionRange -> m VersionRange -> m VersionRange
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
Parse.option VersionRange
VersionRange.anyVersion m VersionRange
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m VersionRange
Parsec.parsec
      m (CompilerFlavor, VersionRange)
-> m () -> m (CompilerFlavor, 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

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

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

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 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
forall a. Pretty a => a -> Doc
Pretty.pretty 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)