{-|
Module      : Prosidy.Compile.FromSetting
Description : Typeclass for parsing values from Prosidy settings.
Copyright   : ©2020 James Alexander Feldman-Crough
License     : MPL-2.0
Maintainer  : alex@fldcr.com
-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
module Prosidy.Compile.FromSetting (FromSetting(..), Sep(..)) where

import           Data.Bifunctor                 ( first )
import           Data.Text                      ( Text )
import           Text.Read                      ( readEither )
import           Type.Reflection                ( Typeable
                                                , typeRep
                                                )
import           GHC.TypeLits                   ( KnownSymbol
                                                , Symbol
                                                , symbolVal'
                                                )
import           GHC.Exts                       ( Proxy#
                                                , proxy#
                                                )

import qualified Data.Text                     as Text
import qualified Data.Text.Lazy                as Text.Lazy

-- | A typeclass for parsing Prosidy settings into typed values. A default
-- instance exists for all types implementing 'Read'.
class FromSetting a where
    -- | Given a 'Text' value containing the setting, either parse a value
    -- or return an error message explaining why the value is malformed.
    fromSetting :: Text -> Either String a

instance FromSetting [Char] where
    fromSetting :: Text -> Either String String
fromSetting = String -> Either String String
forall a b. b -> Either a b
Right (String -> Either String String)
-> (Text -> String) -> Text -> Either String String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack
    {-# INLINE fromSetting #-}

instance FromSetting Text where
    fromSetting :: Text -> Either String Text
fromSetting = Text -> Either String Text
forall a b. b -> Either a b
Right
    {-# INLINE fromSetting #-}

instance FromSetting Text.Lazy.Text where
    fromSetting :: Text -> Either String Text
fromSetting = Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text)
-> (Text -> Text) -> Text -> Either String Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.Lazy.fromStrict
    {-# INLINE fromSetting #-}

instance {-# OVERLAPPABLE #-} (Typeable a, Read a) => FromSetting a where
    fromSetting :: Text -> Either String a
fromSetting txt :: Text
txt = (String -> String) -> Either String a -> Either String a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> String
err (Either String a -> Either String a)
-> (Text -> Either String a) -> Text -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a. Read a => String -> Either String a
readEither (String -> Either String a)
-> (Text -> String) -> Text -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> Either String a) -> Text -> Either String a
forall a b. (a -> b) -> a -> b
$ Text
txt
      where
        err :: String -> String
err = [String -> String] -> String -> String
forall a. Monoid a => [a] -> a
mconcat
            [ String -> String -> String
showString "failed to parse the string "
            , Text -> String -> String
forall a. Show a => a -> String -> String
shows Text
txt
            , String -> String -> String
showString " as a value of type "
            , TypeRep a -> String -> String
forall a. Show a => a -> String -> String
shows (Typeable a => TypeRep a
forall k (a :: k). Typeable a => TypeRep a
typeRep @a)
            , String -> String -> String
showString ": "
            ]

-------------------------------------------------------------------------------
-- | A newtype wrapper for reading in a delimited list of values. The @delim@
-- parameter is a type-level string specifying the seperator between values.
-- It must not be empty, or parsing will fail to terminate.
-- 
-- Sep does not handle escaping or other fancy processing.
newtype Sep (delim :: Symbol) a = Sep { Sep delim a -> [a]
unsep :: [a] }
  deriving (Int -> Sep delim a -> String -> String
[Sep delim a] -> String -> String
Sep delim a -> String
(Int -> Sep delim a -> String -> String)
-> (Sep delim a -> String)
-> ([Sep delim a] -> String -> String)
-> Show (Sep delim a)
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall (delim :: Symbol) a.
Show a =>
Int -> Sep delim a -> String -> String
forall (delim :: Symbol) a.
Show a =>
[Sep delim a] -> String -> String
forall (delim :: Symbol) a. Show a => Sep delim a -> String
showList :: [Sep delim a] -> String -> String
$cshowList :: forall (delim :: Symbol) a.
Show a =>
[Sep delim a] -> String -> String
show :: Sep delim a -> String
$cshow :: forall (delim :: Symbol) a. Show a => Sep delim a -> String
showsPrec :: Int -> Sep delim a -> String -> String
$cshowsPrec :: forall (delim :: Symbol) a.
Show a =>
Int -> Sep delim a -> String -> String
Show, Sep delim a -> Sep delim a -> Bool
(Sep delim a -> Sep delim a -> Bool)
-> (Sep delim a -> Sep delim a -> Bool) -> Eq (Sep delim a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (delim :: Symbol) a.
Eq a =>
Sep delim a -> Sep delim a -> Bool
/= :: Sep delim a -> Sep delim a -> Bool
$c/= :: forall (delim :: Symbol) a.
Eq a =>
Sep delim a -> Sep delim a -> Bool
== :: Sep delim a -> Sep delim a -> Bool
$c== :: forall (delim :: Symbol) a.
Eq a =>
Sep delim a -> Sep delim a -> Bool
Eq, b -> Sep delim a -> Sep delim a
NonEmpty (Sep delim a) -> Sep delim a
Sep delim a -> Sep delim a -> Sep delim a
(Sep delim a -> Sep delim a -> Sep delim a)
-> (NonEmpty (Sep delim a) -> Sep delim a)
-> (forall b. Integral b => b -> Sep delim a -> Sep delim a)
-> Semigroup (Sep delim a)
forall b. Integral b => b -> Sep delim a -> Sep delim a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall (delim :: Symbol) a. NonEmpty (Sep delim a) -> Sep delim a
forall (delim :: Symbol) a.
Sep delim a -> Sep delim a -> Sep delim a
forall (delim :: Symbol) a b.
Integral b =>
b -> Sep delim a -> Sep delim a
stimes :: b -> Sep delim a -> Sep delim a
$cstimes :: forall (delim :: Symbol) a b.
Integral b =>
b -> Sep delim a -> Sep delim a
sconcat :: NonEmpty (Sep delim a) -> Sep delim a
$csconcat :: forall (delim :: Symbol) a. NonEmpty (Sep delim a) -> Sep delim a
<> :: Sep delim a -> Sep delim a -> Sep delim a
$c<> :: forall (delim :: Symbol) a.
Sep delim a -> Sep delim a -> Sep delim a
Semigroup, Semigroup (Sep delim a)
Sep delim a
Semigroup (Sep delim a) =>
Sep delim a
-> (Sep delim a -> Sep delim a -> Sep delim a)
-> ([Sep delim a] -> Sep delim a)
-> Monoid (Sep delim a)
[Sep delim a] -> Sep delim a
Sep delim a -> Sep delim a -> Sep delim a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall (delim :: Symbol) a. Semigroup (Sep delim a)
forall (delim :: Symbol) a. Sep delim a
forall (delim :: Symbol) a. [Sep delim a] -> Sep delim a
forall (delim :: Symbol) a.
Sep delim a -> Sep delim a -> Sep delim a
mconcat :: [Sep delim a] -> Sep delim a
$cmconcat :: forall (delim :: Symbol) a. [Sep delim a] -> Sep delim a
mappend :: Sep delim a -> Sep delim a -> Sep delim a
$cmappend :: forall (delim :: Symbol) a.
Sep delim a -> Sep delim a -> Sep delim a
mempty :: Sep delim a
$cmempty :: forall (delim :: Symbol) a. Sep delim a
$cp1Monoid :: forall (delim :: Symbol) a. Semigroup (Sep delim a)
Monoid, a -> Sep delim b -> Sep delim a
(a -> b) -> Sep delim a -> Sep delim b
(forall a b. (a -> b) -> Sep delim a -> Sep delim b)
-> (forall a b. a -> Sep delim b -> Sep delim a)
-> Functor (Sep delim)
forall a b. a -> Sep delim b -> Sep delim a
forall a b. (a -> b) -> Sep delim a -> Sep delim b
forall (delim :: Symbol) a b. a -> Sep delim b -> Sep delim a
forall (delim :: Symbol) a b.
(a -> b) -> Sep delim a -> Sep delim b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Sep delim b -> Sep delim a
$c<$ :: forall (delim :: Symbol) a b. a -> Sep delim b -> Sep delim a
fmap :: (a -> b) -> Sep delim a -> Sep delim b
$cfmap :: forall (delim :: Symbol) a b.
(a -> b) -> Sep delim a -> Sep delim b
Functor, Functor (Sep delim)
a -> Sep delim a
Functor (Sep delim) =>
(forall a. a -> Sep delim a)
-> (forall a b. Sep delim (a -> b) -> Sep delim a -> Sep delim b)
-> (forall a b c.
    (a -> b -> c) -> Sep delim a -> Sep delim b -> Sep delim c)
-> (forall a b. Sep delim a -> Sep delim b -> Sep delim b)
-> (forall a b. Sep delim a -> Sep delim b -> Sep delim a)
-> Applicative (Sep delim)
Sep delim a -> Sep delim b -> Sep delim b
Sep delim a -> Sep delim b -> Sep delim a
Sep delim (a -> b) -> Sep delim a -> Sep delim b
(a -> b -> c) -> Sep delim a -> Sep delim b -> Sep delim c
forall a. a -> Sep delim a
forall a b. Sep delim a -> Sep delim b -> Sep delim a
forall a b. Sep delim a -> Sep delim b -> Sep delim b
forall a b. Sep delim (a -> b) -> Sep delim a -> Sep delim b
forall a b c.
(a -> b -> c) -> Sep delim a -> Sep delim b -> Sep delim c
forall (delim :: Symbol). Functor (Sep delim)
forall (delim :: Symbol) a. a -> Sep delim a
forall (delim :: Symbol) a b.
Sep delim a -> Sep delim b -> Sep delim a
forall (delim :: Symbol) a b.
Sep delim a -> Sep delim b -> Sep delim b
forall (delim :: Symbol) a b.
Sep delim (a -> b) -> Sep delim a -> Sep delim b
forall (delim :: Symbol) a b c.
(a -> b -> c) -> Sep delim a -> Sep delim b -> Sep delim c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Sep delim a -> Sep delim b -> Sep delim a
$c<* :: forall (delim :: Symbol) a b.
Sep delim a -> Sep delim b -> Sep delim a
*> :: Sep delim a -> Sep delim b -> Sep delim b
$c*> :: forall (delim :: Symbol) a b.
Sep delim a -> Sep delim b -> Sep delim b
liftA2 :: (a -> b -> c) -> Sep delim a -> Sep delim b -> Sep delim c
$cliftA2 :: forall (delim :: Symbol) a b c.
(a -> b -> c) -> Sep delim a -> Sep delim b -> Sep delim c
<*> :: Sep delim (a -> b) -> Sep delim a -> Sep delim b
$c<*> :: forall (delim :: Symbol) a b.
Sep delim (a -> b) -> Sep delim a -> Sep delim b
pure :: a -> Sep delim a
$cpure :: forall (delim :: Symbol) a. a -> Sep delim a
$cp1Applicative :: forall (delim :: Symbol). Functor (Sep delim)
Applicative, Applicative (Sep delim)
a -> Sep delim a
Applicative (Sep delim) =>
(forall a b. Sep delim a -> (a -> Sep delim b) -> Sep delim b)
-> (forall a b. Sep delim a -> Sep delim b -> Sep delim b)
-> (forall a. a -> Sep delim a)
-> Monad (Sep delim)
Sep delim a -> (a -> Sep delim b) -> Sep delim b
Sep delim a -> Sep delim b -> Sep delim b
forall a. a -> Sep delim a
forall a b. Sep delim a -> Sep delim b -> Sep delim b
forall a b. Sep delim a -> (a -> Sep delim b) -> Sep delim b
forall (delim :: Symbol). Applicative (Sep delim)
forall (delim :: Symbol) a. a -> Sep delim a
forall (delim :: Symbol) a b.
Sep delim a -> Sep delim b -> Sep delim b
forall (delim :: Symbol) a b.
Sep delim a -> (a -> Sep delim b) -> Sep delim b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Sep delim a
$creturn :: forall (delim :: Symbol) a. a -> Sep delim a
>> :: Sep delim a -> Sep delim b -> Sep delim b
$c>> :: forall (delim :: Symbol) a b.
Sep delim a -> Sep delim b -> Sep delim b
>>= :: Sep delim a -> (a -> Sep delim b) -> Sep delim b
$c>>= :: forall (delim :: Symbol) a b.
Sep delim a -> (a -> Sep delim b) -> Sep delim b
$cp1Monad :: forall (delim :: Symbol). Applicative (Sep delim)
Monad, a -> Sep delim a -> Bool
Sep delim m -> m
Sep delim a -> [a]
Sep delim a -> Bool
Sep delim a -> Int
Sep delim a -> a
Sep delim a -> a
Sep delim a -> a
Sep delim a -> a
(a -> m) -> Sep delim a -> m
(a -> m) -> Sep delim a -> m
(a -> b -> b) -> b -> Sep delim a -> b
(a -> b -> b) -> b -> Sep delim a -> b
(b -> a -> b) -> b -> Sep delim a -> b
(b -> a -> b) -> b -> Sep delim a -> b
(a -> a -> a) -> Sep delim a -> a
(a -> a -> a) -> Sep delim a -> a
(forall m. Monoid m => Sep delim m -> m)
-> (forall m a. Monoid m => (a -> m) -> Sep delim a -> m)
-> (forall m a. Monoid m => (a -> m) -> Sep delim a -> m)
-> (forall a b. (a -> b -> b) -> b -> Sep delim a -> b)
-> (forall a b. (a -> b -> b) -> b -> Sep delim a -> b)
-> (forall b a. (b -> a -> b) -> b -> Sep delim a -> b)
-> (forall b a. (b -> a -> b) -> b -> Sep delim a -> b)
-> (forall a. (a -> a -> a) -> Sep delim a -> a)
-> (forall a. (a -> a -> a) -> Sep delim a -> a)
-> (forall a. Sep delim a -> [a])
-> (forall a. Sep delim a -> Bool)
-> (forall a. Sep delim a -> Int)
-> (forall a. Eq a => a -> Sep delim a -> Bool)
-> (forall a. Ord a => Sep delim a -> a)
-> (forall a. Ord a => Sep delim a -> a)
-> (forall a. Num a => Sep delim a -> a)
-> (forall a. Num a => Sep delim a -> a)
-> Foldable (Sep delim)
forall a. Eq a => a -> Sep delim a -> Bool
forall a. Num a => Sep delim a -> a
forall a. Ord a => Sep delim a -> a
forall m. Monoid m => Sep delim m -> m
forall a. Sep delim a -> Bool
forall a. Sep delim a -> Int
forall a. Sep delim a -> [a]
forall a. (a -> a -> a) -> Sep delim a -> a
forall m a. Monoid m => (a -> m) -> Sep delim a -> m
forall b a. (b -> a -> b) -> b -> Sep delim a -> b
forall a b. (a -> b -> b) -> b -> Sep delim a -> b
forall (delim :: Symbol) a. Eq a => a -> Sep delim a -> Bool
forall (delim :: Symbol) a. Num a => Sep delim a -> a
forall (delim :: Symbol) a. Ord a => Sep delim a -> a
forall (delim :: Symbol) m. Monoid m => Sep delim m -> m
forall (delim :: Symbol) a. Sep delim a -> Bool
forall (delim :: Symbol) a. Sep delim a -> Int
forall (delim :: Symbol) a. Sep delim a -> [a]
forall (delim :: Symbol) a. (a -> a -> a) -> Sep delim a -> a
forall (delim :: Symbol) m a.
Monoid m =>
(a -> m) -> Sep delim a -> m
forall (delim :: Symbol) b a.
(b -> a -> b) -> b -> Sep delim a -> b
forall (delim :: Symbol) a b.
(a -> b -> b) -> b -> Sep delim a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Sep delim a -> a
$cproduct :: forall (delim :: Symbol) a. Num a => Sep delim a -> a
sum :: Sep delim a -> a
$csum :: forall (delim :: Symbol) a. Num a => Sep delim a -> a
minimum :: Sep delim a -> a
$cminimum :: forall (delim :: Symbol) a. Ord a => Sep delim a -> a
maximum :: Sep delim a -> a
$cmaximum :: forall (delim :: Symbol) a. Ord a => Sep delim a -> a
elem :: a -> Sep delim a -> Bool
$celem :: forall (delim :: Symbol) a. Eq a => a -> Sep delim a -> Bool
length :: Sep delim a -> Int
$clength :: forall (delim :: Symbol) a. Sep delim a -> Int
null :: Sep delim a -> Bool
$cnull :: forall (delim :: Symbol) a. Sep delim a -> Bool
toList :: Sep delim a -> [a]
$ctoList :: forall (delim :: Symbol) a. Sep delim a -> [a]
foldl1 :: (a -> a -> a) -> Sep delim a -> a
$cfoldl1 :: forall (delim :: Symbol) a. (a -> a -> a) -> Sep delim a -> a
foldr1 :: (a -> a -> a) -> Sep delim a -> a
$cfoldr1 :: forall (delim :: Symbol) a. (a -> a -> a) -> Sep delim a -> a
foldl' :: (b -> a -> b) -> b -> Sep delim a -> b
$cfoldl' :: forall (delim :: Symbol) b a.
(b -> a -> b) -> b -> Sep delim a -> b
foldl :: (b -> a -> b) -> b -> Sep delim a -> b
$cfoldl :: forall (delim :: Symbol) b a.
(b -> a -> b) -> b -> Sep delim a -> b
foldr' :: (a -> b -> b) -> b -> Sep delim a -> b
$cfoldr' :: forall (delim :: Symbol) a b.
(a -> b -> b) -> b -> Sep delim a -> b
foldr :: (a -> b -> b) -> b -> Sep delim a -> b
$cfoldr :: forall (delim :: Symbol) a b.
(a -> b -> b) -> b -> Sep delim a -> b
foldMap' :: (a -> m) -> Sep delim a -> m
$cfoldMap' :: forall (delim :: Symbol) m a.
Monoid m =>
(a -> m) -> Sep delim a -> m
foldMap :: (a -> m) -> Sep delim a -> m
$cfoldMap :: forall (delim :: Symbol) m a.
Monoid m =>
(a -> m) -> Sep delim a -> m
fold :: Sep delim m -> m
$cfold :: forall (delim :: Symbol) m. Monoid m => Sep delim m -> m
Foldable)

instance Traversable (Sep delim) where
    traverse :: (a -> f b) -> Sep delim a -> f (Sep delim b)
traverse f :: a -> f b
f = ([b] -> Sep delim b) -> f [b] -> f (Sep delim b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [b] -> Sep delim b
forall (delim :: Symbol) a. [a] -> Sep delim a
Sep (f [b] -> f (Sep delim b))
-> (Sep delim a -> f [b]) -> Sep delim a -> f (Sep delim b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> [a] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f ([a] -> f [b]) -> (Sep delim a -> [a]) -> Sep delim a -> f [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sep delim a -> [a]
forall (delim :: Symbol) a. Sep delim a -> [a]
unsep

instance (KnownSymbol delim, FromSetting a) => FromSetting (Sep delim a) where
    fromSetting :: Text -> Either String (Sep delim a)
fromSetting =
        ([a] -> Sep delim a)
-> Either String [a] -> Either String (Sep delim a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> Sep delim a
forall (delim :: Symbol) a. [a] -> Sep delim a
Sep
            (Either String [a] -> Either String (Sep delim a))
-> (Text -> Either String [a])
-> Text
-> Either String (Sep delim a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either String a) -> [Text] -> Either String [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Text -> Either String a
forall a. FromSetting a => Text -> Either String a
fromSetting
            ([Text] -> Either String [a])
-> (Text -> [Text]) -> Text -> Either String [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null)
            ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
Text.splitOn (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy# delim -> String
forall (n :: Symbol). KnownSymbol n => Proxy# n -> String
symbolVal' (Proxy# delim
forall k (a :: k). Proxy# a
proxy# :: Proxy# delim))