{-# LANGUAGE ScopedTypeVariables #-}
module Main (main) where

import Control.Exception
import Control.Lens
import Control.Monad (forM_)
import Data.Char (isAscii, isSpace)
import Data.List (dropWhileEnd)
import Data.String (fromString)
import Language.Nix.Identifier
import System.Process (callProcess, readCreateProcess, proc)
import Test.Hspec
import Test.QuickCheck
import Text.Parsec.Class (parseM)
import Text.PrettyPrint.HughesPJClass (prettyShow)

main :: IO ()
main = hspec $ do
  describe "Language.Nix.Identifier" $ do
    describe "ident" $ do
      it "is equivalent to fromString" $
        stringIdentProperty $ \str -> fromString str == ident # str
      it "allows recovering the original string after conversion to Identifier" $
        stringIdentProperty $ \str -> view ident (review ident str) == str
      it "can be used as a setter" $
        stringIdentProperty $ \str -> set ident str undefined == ident # str

    describe "HasParser Identifier" $ do
      it "can parse the result of prettyShow" $
        identProperty $ \i -> parseM "Identifier" (prettyShow i) == Just (i :: Identifier)
      it "can parse the result of quote" $
        stringIdentProperty $ \str -> parseM "Identifier" (quote str) == Just (ident # str)
      it "parses redundant escape sequences" $
        forM_
          [ ("\"\\f\"", "f")
          , ("\"echo \\$var\"", "echo $var")
          , ("\"\\h\\e\\l\\l\\o\\ \\w\\or\\l\\d\"", "hello world")
          -- \t and \n don't need to be escaped, though it's advisable
          , ("\"only\\ttechnically\nredundant\"", "only\ttechnically\nredundant")
          ]
          $ \(i, e) -> do
            let e' = Just (ident # e)
            parseM "Identifier" i `shouldBe` e'
            parseM "Identifier" ("\"" ++ e ++ "\"") `shouldBe` e'

    describe "nixKeywords" $ do
      it "are quoted" $ forM_ nixKeywords $ \str -> do
        shouldSatisfy str needsQuoting
        prettyShow (ident # str) `shouldBe` "\"" ++ str ++ "\""

    describe "needsQuoting" $ do
      it "if string contains non ASCII characters" $ stringIdentProperty $ \s ->
        any (not . isAscii) s ==> needsQuoting s
      it "if string contains spaces" $ stringIdentProperty $ \s ->
        any isSpace s ==> needsQuoting s
      it "if length is zero" $ shouldSatisfy "" needsQuoting

    describe "nix-instantiate" $ do
      nixInstantiate <- runIO $ do
        (callProcess nixInstantiateBin [ "--version" ] >> pure (Just nixInstantiateBin))
          `catch` (\(_ :: SomeException) -> pure Nothing)
      let nix :: Example a => String -> (String -> a) -> SpecWith (Arg a)
          nix str spec =
            case nixInstantiate of
              Nothing -> it str $ \_ ->
                pendingWith (nixInstantiateBin ++ " could not be found or executed")
              Just exec -> it str $ spec exec

      nix "accepts our identifiers and reproduces them" $ \exec -> identProperty $ \i -> ioProperty $ do
        let expAttr = prettyShow i
            expr = "{" ++ expAttr ++ "=null;}"

        out <- readCreateProcess (proc exec ["--eval", "--strict", "-E", expr]) ""
        pure $
          extractIdentSyntax out === expAttr
          .&&. parseM "Identifier" (extractIdentSyntax out) === Just i

nixInstantiateBin :: String
nixInstantiateBin = "nix-instantiate"

stringIdentProperty :: Testable prop => (String -> prop) -> Property
stringIdentProperty p = property $ \s ->
  '\0' `notElem` s ==> classify (needsQuoting s) "need quoting" $ p s

identProperty :: Testable prop => (Identifier -> prop) -> Property
identProperty p = property $ \i ->
  classify (needsQuoting (from ident # i)) "need quoting" $ p i

-- | Given the (pretty) printed representation of the Nix value produced by the
--   expression @{ ${ident} = null; }@, for any value of @ident@, extract the
--   part that represents the identifier.
--
--   Note that pretty printing is buggy in some versions of Nix and the result
--   may not actually be valid Nix syntax.
extractIdentSyntax :: String -> String
extractIdentSyntax =
  dropWhileEnd (`elem` "= \n\t")    -- remove "… = "
  . dropWhileEnd (`elem` "null")    -- remove "null"
  . dropWhileEnd (`elem` ";} \n\t") -- remove "…; }"
  . dropWhile (`elem` "{ \n\t")     -- remove "{ …"