overloaded-0.1: example/Example.hs

{-# LANGUAGE OverloadedLabels      #-}
-- {-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS -fplugin=Overloaded -fplugin-opt=Overloaded:Symbols:Numerals:Lists:If:Labels=Overloaded.Symbols.fromSymbol #-}

{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE UndecidableInstances  #-}
module Main (main) where

import qualified Data.ByteString        as BS
import           Data.Fin               (Fin (..))
import           Data.Proxy             (Proxy (..))
import           Data.SOP.BasicFunctors (I (..))
import           Data.SOP.NP            (NP (..), POP (..))
import           Data.String            (IsString (..))
import           Data.Symbol.Ascii      (ReadNat)
import           Data.Type.Equality
import qualified Data.Type.Nat          as N
import           Data.Vec.Lazy          (Vec (..))
import           GHC.Exts               (Constraint)
import           GHC.OverloadedLabels   (IsLabel (..))
import           GHC.TypeLits           (ErrorMessage (..), TypeError, KnownSymbol, KnownNat, symbolVal, Symbol)
import qualified GHC.TypeNats           as Nat
import           Numeric.Natural
import           Test.HUnit             ((@?=))

import Overloaded

-- non-empty string
newtype NES = NES String deriving (Eq, Show)

instance IsString NES where
    fromString = NES

type family NotEmptySymbol (s :: Symbol) :: Constraint where
    NotEmptySymbol "" = TypeError ('ShowType NES ':<>: 'Text " should not be empty")
    NotEmptySymbol s  = ()

instance (KnownSymbol s, NotEmptySymbol s) => FromSymbol s NES where
    fromSymbol = NES $ symbolVal (Proxy :: Proxy s)

-- We don't need this instance, as we have configured the plugin
-- instance (KnownSymbol s, NotEmptySymbol s) => IsLabel s NES where
--     fromLabel = fromSymbol @s

-- | Orphan instance for natural
instance (KnownNat (ReadNat s)) => FromSymbol s Natural where
    fromSymbol = Nat.natVal (Proxy :: Proxy (ReadNat s))



main :: IO ()
main = do
    --Non-Empty String
    let lhs = "foo"
    print lhs
    lhs @?= NES "foo"

    let lhs' = #foo
    print lhs
    lhs' @?= NES "foo"

    -- ByteString
    let bs = "foo" -- try non-ASCII
    bs @?= BS.pack [102, 111, 111]

    -- Numbers
    let n = "2" -- try non digit
    print n
    1 + n @?= (3 :: Natural)

    -- fin: Fin
    let f :: Fin (N.FromGHC 5)
        f = 2

    print f
    f @?= FS (FS FZ)

    -- vec: Vec
    let v :: Vec N.Nat3 Int
        v = [1, 2, 3]

    print v
    v @?= 1 ::: 2 ::: 3 ::: VNil

    -- sop-core: NP and POP
    let np :: NP I '[Int, Bool, String]
        np = [I 1, I True, I "YES"]

    print np
    np @?= I 1 :* I True :* I "YES" :* Nil

    let pop :: POP I '[ '[Int, Bool], '[String] ]
        pop = [[I 0, I False], [I "NO"]]

    print pop
    pop @?= POP ((I 0 :* I False :* Nil) :* (I "NO" :* Nil) :* Nil)

    -- Overloaded:If
    (if True then 'x' else 'y') @?= ('x' :: Char)
    (if Just 'b' then 'x' else 'y') @?= ('x' :: Char)