{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}

module Language.Nix.Binding ( Binding, binding, localName, reference ) where

import Control.DeepSeq
import Control.Lens
import Data.String
import GHC.Generics ( Generic )
import Language.Nix.Identifier
import Language.Nix.Path
import Test.QuickCheck
import Text.Parsec.Class as P
import Text.PrettyPrint.HughesPJClass as PP

-- | A 'Binding' represents an identifier that refers to some other 'Path'.
--
-- >>> :set -XOverloadedStrings
-- >>> "inherit (foo.bar) abc" :: Binding
-- Bind (Identifier "abc") (Path [Identifier "foo",Identifier "bar",Identifier "abc"])
--
-- prop> \b -> Just (b :: Binding) == parseM "Binding" (prettyShow b)

declareLenses [d| data Binding = Bind { localName :: Identifier, reference :: Path }
                    deriving (Show, Eq, Ord, Generic)
              |]

binding :: Iso' Binding (Identifier,Path)
binding :: Iso' Binding (Identifier, Path)
binding = (Binding -> (Identifier, Path))
-> ((Identifier, Path) -> Binding)
-> Iso' Binding (Identifier, Path)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(Bind Identifier
l Path
r) -> (Identifier
l,Path
r)) ((Identifier -> Path -> Binding) -> (Identifier, Path) -> Binding
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Identifier -> Path -> Binding
Bind)

instance NFData Binding where
  rnf :: Binding -> ()
rnf (Bind Identifier
l Path
r) = Identifier
l Identifier -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Path -> ()
forall a. NFData a => a -> ()
rnf Path
r

instance Arbitrary Binding where
  arbitrary :: Gen Binding
arbitrary = AReview Binding (Identifier, Path) -> (Identifier, Path) -> Binding
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview Binding (Identifier, Path)
Iso' Binding (Identifier, Path)
binding ((Identifier, Path) -> Binding)
-> Gen (Identifier, Path) -> Gen Binding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Identifier, Path)
forall a. Arbitrary a => Gen a
arbitrary

instance CoArbitrary Binding

instance Pretty Binding where
  pPrint :: Binding -> Doc
pPrint Binding
b = case ([Identifier] -> [Identifier]
forall a. HasCallStack => [a] -> [a]
init [Identifier]
ps, [Identifier] -> Identifier
forall a. HasCallStack => [a] -> a
last [Identifier]
ps) of
               ([], Identifier
i') -> if Identifier
i Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
i'
                              then String -> Doc
text String
"inherit" Doc -> Doc -> Doc
<+> Identifier -> Doc
forall a. Pretty a => a -> Doc
pPrint Identifier
i'
                              else Identifier -> Doc
forall a. Pretty a => a -> Doc
pPrint Identifier
i Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> Path -> Doc
forall a. Pretty a => a -> Doc
pPrint Path
p
               ([Identifier]
p', Identifier
i') -> if Identifier
i Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
i'
                              then String -> Doc
text String
"inherit" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Path -> Doc
forall a. Pretty a => a -> Doc
pPrint (Tagged [Identifier] (Identity [Identifier])
-> Tagged Path (Identity Path)
Iso' Path [Identifier]
path (Tagged [Identifier] (Identity [Identifier])
 -> Tagged Path (Identity Path))
-> [Identifier] -> Path
forall t b. AReview t b -> b -> t
# [Identifier]
p')) Doc -> Doc -> Doc
<+> Identifier -> Doc
forall a. Pretty a => a -> Doc
pPrint Identifier
i'
                              else Identifier -> Doc
forall a. Pretty a => a -> Doc
pPrint Identifier
i Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> Path -> Doc
forall a. Pretty a => a -> Doc
pPrint Path
p

          where
            (Identifier
i, Path
p) = Getting (Identifier, Path) Binding (Identifier, Path)
-> Binding -> (Identifier, Path)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Identifier, Path) Binding (Identifier, Path)
Iso' Binding (Identifier, Path)
binding Binding
b
            ps :: [Identifier]
ps = Getting [Identifier] Path [Identifier] -> Path -> [Identifier]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Identifier] Path [Identifier]
Iso' Path [Identifier]
path Path
p

instance HasParser Binding where
  parser :: forall st input (m :: * -> *). CharParser st input m Binding
parser = ParsecT st input m Binding -> ParsecT st input m Binding
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT st input m Binding
forall st input (m :: * -> *). CharParser st input m Binding
parseInherit ParsecT st input m Binding
-> ParsecT st input m Binding -> ParsecT st input m Binding
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT st input m Binding
forall st input (m :: * -> *). CharParser st input m Binding
parseAssignment

instance IsString Binding where
  fromString :: String -> Binding
fromString = String -> String -> Binding
forall input a.
(Stream input Identity Char, HasParser a) =>
String -> input -> a
parse String
"Language.Nix.Binding.Binding"

parseAssignment :: CharParser st tok m Binding
parseAssignment :: forall st input (m :: * -> *). CharParser st input m Binding
parseAssignment = do Identifier
l <- ParsecT st tok m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT st tok m ()
-> ParsecT st tok m Identifier -> ParsecT st tok m Identifier
forall a b.
ParsecT st tok m a -> ParsecT st tok m b -> ParsecT st tok m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT st tok m Identifier
forall a st input (m :: * -> *).
HasParser a =>
CharParser st input m a
forall st input (m :: * -> *). CharParser st input m Identifier
parser
                     Char
_ <- ParsecT st tok m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT st tok m ()
-> ParsecT st tok m Char -> ParsecT st tok m Char
forall a b.
ParsecT st tok m a -> ParsecT st tok m b -> ParsecT st tok m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT st tok m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'='
                     Path
r <- ParsecT st tok m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT st tok m ()
-> ParsecT st tok m Path -> ParsecT st tok m Path
forall a b.
ParsecT st tok m a -> ParsecT st tok m b -> ParsecT st tok m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT st tok m Path
forall a st input (m :: * -> *).
HasParser a =>
CharParser st input m a
forall st input (m :: * -> *). CharParser st input m Path
parser
                     Binding -> ParsecT st tok m Binding
forall a. a -> ParsecT st tok m a
forall (m :: * -> *) a. Monad m => a -> m a
return (AReview Binding (Identifier, Path)
Iso' Binding (Identifier, Path)
binding AReview Binding (Identifier, Path) -> (Identifier, Path) -> Binding
forall t b. AReview t b -> b -> t
# (Identifier
l,Path
r))

parseInherit :: CharParser st tok m Binding
parseInherit :: forall st input (m :: * -> *). CharParser st input m Binding
parseInherit = do Char
_ <- ParsecT st tok m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT st tok m ()
-> ParsecT st tok m String -> ParsecT st tok m String
forall a b.
ParsecT st tok m a -> ParsecT st tok m b -> ParsecT st tok m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT st tok m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"inherit" ParsecT st tok m String
-> ParsecT st tok m Char -> ParsecT st tok m Char
forall a b.
ParsecT st tok m a -> ParsecT st tok m b -> ParsecT st tok m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT st tok m Char -> ParsecT st tok m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT st tok m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.space ParsecT st tok m Char
-> ParsecT st tok m Char -> ParsecT st tok m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT st tok m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'(')
                  [Identifier]
p <- [Identifier]
-> ParsecT st tok m [Identifier] -> ParsecT st tok m [Identifier]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (ParsecT st tok m [Identifier] -> ParsecT st tok m [Identifier])
-> ParsecT st tok m [Identifier] -> ParsecT st tok m [Identifier]
forall a b. (a -> b) -> a -> b
$ ParsecT st tok m [Identifier] -> ParsecT st tok m [Identifier]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT st tok m [Identifier] -> ParsecT st tok m [Identifier])
-> ParsecT st tok m [Identifier] -> ParsecT st tok m [Identifier]
forall a b. (a -> b) -> a -> b
$ ParsecT st tok m Char
-> ParsecT st tok m Char
-> ParsecT st tok m [Identifier]
-> ParsecT st tok m [Identifier]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (ParsecT st tok m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT st tok m ()
-> ParsecT st tok m Char -> ParsecT st tok m Char
forall a b.
ParsecT st tok m a -> ParsecT st tok m b -> ParsecT st tok m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT st tok m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'(')
                                                 (ParsecT st tok m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT st tok m ()
-> ParsecT st tok m Char -> ParsecT st tok m Char
forall a b.
ParsecT st tok m a -> ParsecT st tok m b -> ParsecT st tok m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT st tok m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
')')
                                                 (ParsecT st tok m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT st tok m ()
-> ParsecT st tok m [Identifier] -> ParsecT st tok m [Identifier]
forall a b.
ParsecT st tok m a -> ParsecT st tok m b -> ParsecT st tok m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Getting [Identifier] Path [Identifier] -> Path -> [Identifier]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Identifier] Path [Identifier]
Iso' Path [Identifier]
path (Path -> [Identifier])
-> ParsecT st tok m Path -> ParsecT st tok m [Identifier]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT st tok m Path
forall a st input (m :: * -> *).
HasParser a =>
CharParser st input m a
forall st input (m :: * -> *). CharParser st input m Path
parser)
                  Identifier
i <- ParsecT st tok m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT st tok m ()
-> ParsecT st tok m Identifier -> ParsecT st tok m Identifier
forall a b.
ParsecT st tok m a -> ParsecT st tok m b -> ParsecT st tok m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT st tok m Identifier
forall a st input (m :: * -> *).
HasParser a =>
CharParser st input m a
forall st input (m :: * -> *). CharParser st input m Identifier
parser
                  Binding -> ParsecT st tok m Binding
forall a. a -> ParsecT st tok m a
forall (m :: * -> *) a. Monad m => a -> m a
return (AReview Binding (Identifier, Path)
Iso' Binding (Identifier, Path)
binding AReview Binding (Identifier, Path) -> (Identifier, Path) -> Binding
forall t b. AReview t b -> b -> t
# (Identifier
i, Tagged [Identifier] (Identity [Identifier])
-> Tagged Path (Identity Path)
Iso' Path [Identifier]
path (Tagged [Identifier] (Identity [Identifier])
 -> Tagged Path (Identity Path))
-> [Identifier] -> Path
forall t b. AReview t b -> b -> t
# ([Identifier]
p [Identifier] -> [Identifier] -> [Identifier]
forall a. [a] -> [a] -> [a]
++ [Identifier
i])))