{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DefaultSignatures #-}
module Data.Svfactor.Parse.Options (
ParseOptions (ParseOptions, _headedness, _endOnBlankLine, _parseSeparator, _encodeString)
, HasParseOptions (parseOptions, endOnBlankLine, encodeString)
, HasSeparator (..)
, HasHeadedness (..)
, defaultParseOptions
, defaultHeadedness
, defaultSeparator
) where
import Control.Lens (Lens, lens)
import Data.ByteString.UTF8 (ByteString, fromString)
import Data.Svfactor.Syntax.Sv (HasSeparator (separator), HasHeadedness (headedness), Headedness (Headed), Separator, comma)
data ParseOptions s =
ParseOptions {
_parseSeparator :: Separator
, _headedness :: Headedness
, _endOnBlankLine :: Bool
, _encodeString :: String -> s
}
instance Functor ParseOptions where
fmap f (ParseOptions s h e enc) = ParseOptions s h e (f . enc)
class (HasSeparator s, HasHeadedness s) => HasParseOptions s t a b | s -> a, t -> b, s b -> t, t a -> s where
parseOptions :: Lens s t (ParseOptions a) (ParseOptions b)
encodeString :: Lens s t (String -> a) (String -> b)
{-# INLINE encodeString #-}
endOnBlankLine :: s ~ t => Lens s t Bool Bool
{-# INLINE endOnBlankLine #-}
encodeString = parseOptions . encodeString
default endOnBlankLine :: (s ~ t, a ~ b) => Lens s t Bool Bool
endOnBlankLine = parseOptions . endOnBlankLine
instance HasParseOptions (ParseOptions a) (ParseOptions b) a b where
parseOptions = id
{-# INLINE parseOptions #-}
encodeString = lens _encodeString (\c s -> c { _encodeString = s })
{-# INLINE encodeString #-}
endOnBlankLine = lens _endOnBlankLine (\c b -> c { _endOnBlankLine = b })
{-# INLINE endOnBlankLine #-}
instance HasSeparator (ParseOptions s) where
separator =
lens _parseSeparator (\c s -> c { _parseSeparator = s })
{-# INLINE separator #-}
instance HasHeadedness (ParseOptions s) where
headedness =
lens _headedness (\c h -> c { _headedness = h })
{-# INLINE headedness #-}
defaultParseOptions :: ParseOptions ByteString
defaultParseOptions = ParseOptions defaultSeparator defaultHeadedness False fromString
defaultSeparator :: Separator
defaultSeparator = comma
defaultHeadedness :: Headedness
defaultHeadedness = Headed