{-| 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 = Right . Text.unpack {-# INLINE fromSetting #-} instance FromSetting Text where fromSetting = Right {-# INLINE fromSetting #-} instance FromSetting Text.Lazy.Text where fromSetting = Right . Text.Lazy.fromStrict {-# INLINE fromSetting #-} instance {-# OVERLAPPABLE #-} (Typeable a, Read a) => FromSetting a where fromSetting txt = first err . readEither . Text.unpack $ txt where err = mconcat [ showString "failed to parse the string " , shows txt , showString " as a value of type " , shows (typeRep @a) , 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 { unsep :: [a] } deriving (Show, Eq, Semigroup, Monoid, Functor, Applicative, Monad, Foldable) instance Traversable (Sep delim) where traverse f = fmap Sep . traverse f . unsep instance (KnownSymbol delim, FromSetting a) => FromSetting (Sep delim a) where fromSetting = fmap Sep . traverse fromSetting . filter (not . Text.null) . Text.splitOn (Text.pack $ symbolVal' (proxy# :: Proxy# delim))