BasicTest.hs

module Exon.Test.BasicTest where

import Data.Text (toUpper)
import Hedgehog (TestT, (===))

import Exon.Class.Exon (ExonSegment (exonSegment), SkipWs (SkipWs), skipWs)
import Exon.Data.Result (Result (Result))
import qualified Exon.Data.Segment as Segment
import Exon.Quote (exon, exonws, intron)

newtype Mon =
  Mon String
  deriving stock (Eq, Show)
  deriving newtype (IsString)

instance Semigroup Mon where
  Mon l <> Mon r =
    Mon (l <> r)

instance Monoid Mon where
  mempty =
    Mon ""

newtype Name =
  Name Text
  deriving newtype (Eq, Show, Monoid, IsString)

instance Semigroup Name where
  Name l <> Name r =
    Name (l <> " | " <> r)

lastName :: Name
lastName = "Fry"

up :: Name -> Name
up (Name name) =
  Name (toUpper name)

test_basic :: TestT IO ()
test_basic = do
  Mon "fooandbar" === [intron|foo
    #{var} bar|]
  "Philip | J. | FRY" === [intron|Philip J. #{up lastName}|]
  "Philip | J. | FRY" === skipWs [exonws|Philip J. #{SkipWs (up lastName)}|]
  "Philip J. | FRY" === [exon|Philip J.#{up lastName}|]
  ("abc" :: Text) === skipWs [exonws|a  ##{"b" :: Text} #{"c"}|]
  where
    var :: IsString a => a
    var =
      "and"

newtype Thing = Thing String deriving stock (Generic) deriving newtype (IsString, Show, Eq)

instance ExonSegment Thing String where
  exonSegment = \case
    Segment.String s -> Result s
    Segment.Expression thing -> Result thing
    Segment.Whitespace _ -> Result " >>> "

test_customWhitespace :: TestT IO ()
test_customWhitespace =
  Thing "1 >>> 2 >>> 3" === [exonws|1 #{Thing "2"}    3|]