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

module Language.Nix.Path ( Path, path ) where

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

-- $setup
-- >>> import Control.Exception as Excpt

-- | Paths are non-empty lists of identifiers in Nix.
--
-- >>> path # [ident # "yo"]
-- Path [Identifier "yo"]
--
-- Any attempt to construct the empty path throws an 'error':
--
-- >>> :set -XScopedTypeVariables
-- >>> either (\(_::SomeException) -> "empty paths are illegal") show <$> Excpt.try (evaluate (path # []))
-- "empty paths are illegal"
--
-- Paths can be pretty-printed and parsed with the 'Text' class:
--
-- >>> parse "Path" "foo.\"foo.bar\".bar" :: Path
-- Path [Identifier "foo",Identifier "foo.bar",Identifier "bar"]
-- >>> pPrint (parse "Path" "foo.\"foo\".\"bar\".bar" :: Path)
-- foo.foo.bar.bar
--
-- prop> \p -> Just (p :: Path) == parseM "Path" (prettyShow p)
--
-- Paths are instances of strings and can be implicitly converted:
--
-- >>> :set -XOverloadedStrings
-- >>> pPrint $ ("yo.bar" :: Path)
-- yo.bar
-- >>> pPrint $ ("  yo  .  bar" :: Path)
-- yo.bar
--
-- Freaky quoted identifiers are fine throughout:
--
-- >>> pPrint $ path # ["yo","b\"ar"]
-- yo."b\"ar"
-- >>> pPrint ("\"5ident\"" :: Path)
-- "5ident"
-- >>> pPrint $ path # ["5ident","foo.bar","foo\nbar"]
-- "5ident"."foo.bar"."foo\nbar"

declareLenses [d| newtype Path = Path [Identifier]
                    deriving (Show, Eq, Ord, Generic)
              |]

instance NFData Path where
  rnf :: Path -> ()
rnf (Path [Identifier]
p) = [Identifier] -> ()
forall a. NFData a => a -> ()
rnf [Identifier]
p

instance Pretty Path where
  pPrint :: Path -> Doc
pPrint Path
p = [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate (Char -> Doc
PP.char Char
'.') ((Identifier -> Doc) -> [Identifier] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Identifier -> Doc
forall a. Pretty a => a -> Doc
pPrint (Path
pPath -> Getting [Identifier] Path [Identifier] -> [Identifier]
forall s a. s -> Getting a s a -> a
^.Getting [Identifier] Path [Identifier]
Iso' Path [Identifier]
path))

instance HasParser Path where
  parser :: forall st input (m :: * -> *). CharParser st input m Path
parser = AReview Path [Identifier] -> [Identifier] -> Path
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview Path [Identifier]
Iso' Path [Identifier]
path ([Identifier] -> Path)
-> ParsecT st input m [Identifier] -> ParsecT st input m Path
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT st input m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT st input m ()
-> ParsecT st input m Identifier -> ParsecT st input m Identifier
forall a b.
ParsecT st input m a
-> ParsecT st input m b -> ParsecT st input m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT st input m Identifier
forall a st input (m :: * -> *).
HasParser a =>
CharParser st input m a
forall st input (m :: * -> *). CharParser st input m Identifier
parser) ParsecT st input m Identifier
-> ParsecT st input m Char -> ParsecT st input m [Identifier]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` (ParsecT st input m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT st input m ()
-> ParsecT st input m Char -> ParsecT st input m Char
forall a b.
ParsecT st input m a
-> ParsecT st input m b -> ParsecT st input m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT st input m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'.')

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

instance Arbitrary Path where
  arbitrary :: Gen Path
arbitrary = [Identifier] -> Path
Path ([Identifier] -> Path) -> Gen [Identifier] -> Gen Path
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Identifier -> Gen [Identifier]
forall a. Gen a -> Gen [a]
listOf1 Gen Identifier
forall a. Arbitrary a => Gen a
arbitrary

instance CoArbitrary Path

-- | Use this isomorphism to construct a path from a list of identifiers, or to
-- access that list for a given path.

path :: Iso' Path [Identifier]
path :: Iso' Path [Identifier]
path = (Path -> [Identifier])
-> ([Identifier] -> Path) -> Iso' Path [Identifier]
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(Path [Identifier]
p) -> [Identifier]
p) (\[Identifier]
p -> if [Identifier] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Identifier]
p then String -> Path
forall a. HasCallStack => String -> a
error String
"Nix paths cannot be empty" else [Identifier] -> Path
Path [Identifier]
p)