Types.hs

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_GHC -Wwarn #-}

module Ide.Plugin.Eval.Types (
    locate,
    locate0,
    Test (..),
    isProperty,
    Format (..),
    Language (..),
    Section (..),
    hasTests,
    hasPropertyTest,
    splitSections,
    Loc,
    Located (..),
    unLoc,
    Txt,
) where

import Control.DeepSeq (NFData (rnf), deepseq)
import Data.Aeson (FromJSON, ToJSON)
import Data.List (partition)
import Data.List.NonEmpty (NonEmpty)
import Data.String (IsString (..))
import GHC.Generics (Generic)

-- | A thing with a location attached.
data Located l a = Located {location :: l, located :: a}
    deriving (Eq, Show, Ord, Functor, Generic, FromJSON, ToJSON)

-- | Discard location information.
unLoc :: Located l a -> a
unLoc (Located _ a) = a

instance (NFData l, NFData a) => NFData (Located l a) where
    rnf (Located loc a) = loc `deepseq` a `deepseq` ()

type Loc = Located Line

type Line = Int

locate :: Loc [a] -> [Loc a]
locate (Located l tst) = zipWith Located [l ..] tst

locate0 :: [a] -> [Loc a]
locate0 = locate . Located 0

type Txt = String

data Section = Section
    { sectionName :: Txt
    , sectionTests :: [Loc Test]
    , sectionLanguage :: Language
    , sectionFormat :: Format
    }
    deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)

hasTests :: Section -> Bool
hasTests = not . null . sectionTests

hasPropertyTest :: Section -> Bool
hasPropertyTest = any (isProperty . unLoc) . sectionTests

-- |Split setup and normal sections
splitSections :: [Section] -> ([Section], [Section])
splitSections = partition ((== "setup") . sectionName)

data Test
    = Example {testLines :: NonEmpty Txt, testOutput :: [Txt]}
    | Property {testline :: Txt, testOutput :: [Txt]}
    deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)

isProperty :: Test -> Bool
isProperty (Property _ _) = True
isProperty _ = False

data Format = SingleLine | MultiLine deriving (Eq, Show, Ord, Generic, FromJSON, ToJSON, NFData)

data Language = Plain | Haddock deriving (Eq, Show, Generic, Ord, FromJSON, ToJSON, NFData)

data ExpectedLine = ExpectedLine [LineChunk] | WildCardLine
    deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)

instance IsString ExpectedLine where
    fromString = ExpectedLine . return . LineChunk

data LineChunk = LineChunk String | WildCardChunk
    deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)

instance IsString LineChunk where
    fromString = LineChunk