{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}

module Floskell.ConfigFile
    ( AppConfig(..)
    , defaultAppConfig
    , findAppConfig
    , findAppConfigIn
    , readAppConfig
    , showStyle
    , showLanguage
    , showExtension
    , showFixity
    , lookupStyle
    , lookupLanguage
    , lookupExtension
    , lookupFixity
    , setStyle
    , setLanguage
    , setExtensions
    , setFixities
    ) where

import           Control.Applicative        ( (<|>) )

import           Data.Aeson
                 ( (.:?), (.=), FromJSON(..), ToJSON(..) )
import qualified Data.Aeson                 as JSON
import qualified Data.Aeson.Types           as JSON ( typeMismatch )
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap          as JSON ( unionWith )
#endif
import qualified Data.Attoparsec.ByteString as AP
import qualified Data.ByteString            as BS
import           Data.Char                  ( isLetter, isSpace )

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap          as Map
#else
import qualified Data.Aeson.Parser          as JSON ( json' )
import qualified Data.HashMap.Lazy          as Map
#endif

import           Data.List                  ( inits )
import qualified Data.Text                  as T

import           Floskell.Attoparsec        ( parseOnly )
import           Floskell.Styles            ( Style(..), styles )

import           GHC.Generics               ( Generic )

import           Language.Haskell.Exts
                 ( Extension(..), Fixity(..), Language(..), classifyExtension
                 , classifyLanguage )
import qualified Language.Haskell.Exts      as HSE

import           System.Directory
                 ( XdgDirectory(..), doesFileExist, findFileWith
                 , getAppUserDataDirectory, getCurrentDirectory
                 , getHomeDirectory, getXdgDirectory )
import           System.FilePath
                 ( joinPath, splitDirectories, takeDirectory )

data AppConfig = AppConfig { AppConfig -> Style
appStyle      :: Style
                           , AppConfig -> Language
appLanguage   :: Language
                           , AppConfig -> [Extension]
appExtensions :: [Extension]
                           , AppConfig -> [Fixity]
appFixities   :: [Fixity]
                           }
    deriving ( (forall x. AppConfig -> Rep AppConfig x)
-> (forall x. Rep AppConfig x -> AppConfig) -> Generic AppConfig
forall x. Rep AppConfig x -> AppConfig
forall x. AppConfig -> Rep AppConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AppConfig x -> AppConfig
$cfrom :: forall x. AppConfig -> Rep AppConfig x
Generic )

instance ToJSON AppConfig where
    toJSON :: AppConfig -> Value
toJSON AppConfig{[Fixity]
[Extension]
Language
Style
appFixities :: [Fixity]
appExtensions :: [Extension]
appLanguage :: Language
appStyle :: Style
appFixities :: AppConfig -> [Fixity]
appExtensions :: AppConfig -> [Extension]
appLanguage :: AppConfig -> Language
appStyle :: AppConfig -> Style
..} =
        [Pair] -> Value
JSON.object [ Key
"style" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Style -> String
showStyle Style
appStyle
                    , Key
"language" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Language -> String
showLanguage Language
appLanguage
                    , Key
"extensions" Key -> [String] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Extension -> String) -> [Extension] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Extension -> String
showExtension [Extension]
appExtensions
                    , Key
"fixities" Key -> [String] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Fixity -> String) -> [Fixity] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Fixity -> String
showFixity [Fixity]
appFixities
                    , Key
"formatting" Key -> Config -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Style -> Config
styleConfig Style
appStyle
                    ]

instance FromJSON AppConfig where
    parseJSON :: Value -> Parser AppConfig
parseJSON (JSON.Object Object
o) = do
        Style
style <- Style -> (String -> Style) -> Maybe String -> Style
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AppConfig -> Style
appStyle AppConfig
defaultAppConfig) String -> Style
lookupStyle (Maybe String -> Style) -> Parser (Maybe String) -> Parser Style
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"style"
        Language
language <- Language -> (String -> Language) -> Maybe String -> Language
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AppConfig -> Language
appLanguage AppConfig
defaultAppConfig) String -> Language
lookupLanguage
            (Maybe String -> Language)
-> Parser (Maybe String) -> Parser Language
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"language"
        [Extension]
extensions <- [Extension]
-> ([String] -> [Extension]) -> Maybe [String] -> [Extension]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AppConfig -> [Extension]
appExtensions AppConfig
defaultAppConfig)
                            ((String -> Extension) -> [String] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map String -> Extension
lookupExtension) (Maybe [String] -> [Extension])
-> Parser (Maybe [String]) -> Parser [Extension]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe [String])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"extensions"
        [Fixity]
fixities <- [Fixity] -> ([String] -> [Fixity]) -> Maybe [String] -> [Fixity]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AppConfig -> [Fixity]
appFixities AppConfig
defaultAppConfig) ((String -> Fixity) -> [String] -> [Fixity]
forall a b. (a -> b) -> [a] -> [b]
map String -> Fixity
lookupFixity)
            (Maybe [String] -> [Fixity])
-> Parser (Maybe [String]) -> Parser [Fixity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe [String])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"fixities"
        let fmt :: Config
fmt = Style -> Config
styleConfig Style
style
        Config
fmt' <- Config -> (Value -> Config) -> Maybe Value -> Config
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Config
fmt (Config -> Value -> Config
forall p a. (FromJSON p, ToJSON a) => a -> Value -> p
updateConfig Config
fmt) (Maybe Value -> Config) -> Parser (Maybe Value) -> Parser Config
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"formatting"
        let style' :: Style
style' = Style
style { styleConfig :: Config
styleConfig = Config
fmt' }
        AppConfig -> Parser AppConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (AppConfig -> Parser AppConfig) -> AppConfig -> Parser AppConfig
forall a b. (a -> b) -> a -> b
$ Style -> Language -> [Extension] -> [Fixity] -> AppConfig
AppConfig Style
style' Language
language [Extension]
extensions [Fixity]
fixities
      where
        updateConfig :: a -> Value -> p
updateConfig a
cfg Value
v = case Value -> Result p
forall a. FromJSON a => Value -> Result a
JSON.fromJSON (Value -> Result p) -> Value -> Result p
forall a b. (a -> b) -> a -> b
$ Value -> Value -> Value
mergeJSON (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
cfg) Value
v of
            JSON.Error String
e -> String -> p
forall a. HasCallStack => String -> a
error String
e
            JSON.Success p
x -> p
x

        mergeJSON :: Value -> Value -> Value
mergeJSON Value
JSON.Null Value
r = Value
r
        mergeJSON Value
l Value
JSON.Null = Value
l
        mergeJSON (JSON.Object Object
l) (JSON.Object Object
r) =
            Object -> Value
JSON.Object ((Value -> Value -> Value) -> Object -> Object -> Object
forall v. (v -> v -> v) -> KeyMap v -> KeyMap v -> KeyMap v
Map.unionWith Value -> Value -> Value
mergeJSON Object
l Object
r)
        mergeJSON Value
_ Value
r = Value
r

    parseJSON Value
v = String -> Value -> Parser AppConfig
forall a. String -> Value -> Parser a
JSON.typeMismatch String
"AppConfig" Value
v

-- | Default program configuration.
defaultAppConfig :: AppConfig
defaultAppConfig :: AppConfig
defaultAppConfig = Style -> Language -> [Extension] -> [Fixity] -> AppConfig
AppConfig ([Style] -> Style
forall a. [a] -> a
head [Style]
styles) Language
Haskell2010 [] []

-- | Show name of a style.
showStyle :: Style -> String
showStyle :: Style -> String
showStyle = Text -> String
T.unpack (Text -> String) -> (Style -> Text) -> Style -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> Text
styleName

-- | Show a Haskell language name.
showLanguage :: Language -> String
showLanguage :: Language -> String
showLanguage = Language -> String
forall a. Show a => a -> String
show

-- | Show a Haskell language extension.
showExtension :: Extension -> String
showExtension :: Extension -> String
showExtension (EnableExtension KnownExtension
x) = KnownExtension -> String
forall a. Show a => a -> String
show KnownExtension
x
showExtension (DisableExtension KnownExtension
x) = String
"No" String -> String -> String
forall a. [a] -> [a] -> [a]
++ KnownExtension -> String
forall a. Show a => a -> String
show KnownExtension
x
showExtension (UnknownExtension String
x) = String
x

-- | Show a fixity declaration.
showFixity :: Fixity -> String
showFixity :: Fixity -> String
showFixity (Fixity Assoc ()
assoc Int
prec QName ()
op) =
    Assoc () -> String
forall p l. IsString p => Assoc l -> p
showAssoc Assoc ()
assoc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
prec String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QName () -> String
forall l. QName l -> String
showOp QName ()
op
  where
    showAssoc :: Assoc l -> p
showAssoc (HSE.AssocNone l
_) = p
"infix"
    showAssoc (HSE.AssocLeft l
_) = p
"infixl"
    showAssoc (HSE.AssocRight l
_) = p
"infixr"

    showOp :: QName l -> String
showOp (HSE.UnQual l
_ (HSE.Symbol l
_ String
symbol)) = String
symbol
    showOp (HSE.UnQual l
_ (HSE.Ident l
_ String
ident)) = String
"`" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ident String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"`"
    showOp QName l
_ = String -> String
forall a. HasCallStack => String -> a
error String
"Operator in fixity list not supported"

-- | Lookup a style by name.
lookupStyle :: String -> Style
lookupStyle :: String -> Style
lookupStyle String
name = case (Style -> Bool) -> [Style] -> [Style]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
name) (Text -> Bool) -> (Style -> Text) -> Style -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> Text
styleName) [Style]
styles of
    [] -> String -> Style
forall a. HasCallStack => String -> a
error (String -> Style) -> String -> Style
forall a b. (a -> b) -> a -> b
$ String
"Unknown style: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
    Style
x : [Style]
_ -> Style
x

-- | Lookup a language by name.
lookupLanguage :: String -> Language
lookupLanguage :: String -> Language
lookupLanguage String
name = case String -> Language
classifyLanguage String
name of
    UnknownLanguage String
_ -> String -> Language
forall a. HasCallStack => String -> a
error (String -> Language) -> String -> Language
forall a b. (a -> b) -> a -> b
$ String
"Unknown language: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
    Language
x -> Language
x

-- | Lookup an extension by name.
lookupExtension :: String -> Extension
lookupExtension :: String -> Extension
lookupExtension String
name = case String -> Extension
classifyExtension String
name of
    UnknownExtension String
_ -> String -> Extension
forall a. HasCallStack => String -> a
error (String -> Extension) -> String -> Extension
forall a b. (a -> b) -> a -> b
$ String
"Unkown extension: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
    Extension
x -> Extension
x

-- | Parse a fixity declaration.
lookupFixity :: String -> Fixity
lookupFixity :: String -> Fixity
lookupFixity String
decl =
    let (String
assoc, String
decl') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
decl
        (String
prec, String
decl'') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
decl'
        (String
op, String
_) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
decl''
    in
        Assoc () -> Int -> QName () -> Fixity
Fixity (String -> Assoc ()
readAssoc String
assoc) (String -> Int
forall a. Read a => String -> a
read String
prec) (String -> QName ()
readOp String
op)
  where
    readAssoc :: String -> Assoc ()
readAssoc String
"infix" = () -> Assoc ()
forall l. l -> Assoc l
HSE.AssocNone ()
    readAssoc String
"infixl" = () -> Assoc ()
forall l. l -> Assoc l
HSE.AssocLeft ()
    readAssoc String
"infixr" = () -> Assoc ()
forall l. l -> Assoc l
HSE.AssocRight ()
    readAssoc String
assoc = String -> Assoc ()
forall a. HasCallStack => String -> a
error (String -> Assoc ()) -> String -> Assoc ()
forall a b. (a -> b) -> a -> b
$ String
"Unknown associativity: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
assoc

    readOp :: String -> QName ()
readOp String
op = () -> Name () -> QName ()
forall l. l -> Name l -> QName l
HSE.UnQual () (Name () -> QName ()) -> Name () -> QName ()
forall a b. (a -> b) -> a -> b
$ case String
op of
        Char
'(' : String
op' -> () -> String -> Name ()
forall l. l -> String -> Name l
HSE.Symbol () (String -> String
forall a. [a] -> [a]
init String
op')
        Char
'`' : String
op' -> () -> String -> Name ()
forall l. l -> String -> Name l
HSE.Ident () (String -> String
forall a. [a] -> [a]
init String
op')
        Char
c : String
_ -> if Char -> Bool
isLetter Char
c then () -> String -> Name ()
forall l. l -> String -> Name l
HSE.Ident () String
op else () -> String -> Name ()
forall l. l -> String -> Name l
HSE.Symbol () String
op
        String
_ -> String -> Name ()
forall a. HasCallStack => String -> a
error String
"Missing operator in infix declaration"

-- | Try to find a configuration file based on current working
-- directory, or in one of the application configuration directories.
findAppConfig :: IO (Maybe FilePath)
findAppConfig :: IO (Maybe String)
findAppConfig = IO String
getCurrentDirectory IO String -> (String -> IO (Maybe String)) -> IO (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO (Maybe String)
findAppConfigIn

findAppConfigIn :: FilePath -> IO (Maybe FilePath)
findAppConfigIn :: String -> IO (Maybe String)
findAppConfigIn String
src = do
    Bool
isFile <- String -> IO Bool
doesFileExist String
src
    let startFrom :: String
startFrom = if Bool
isFile then String -> String
takeDirectory String
src else String
src

    [String]
dotfilePaths <- [IO String] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ IO String
getHomeDirectory, XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgConfig String
"" ]
    Maybe String
dotfileConfig <- (String -> IO Bool) -> [String] -> String -> IO (Maybe String)
findFileWith String -> IO Bool
doesFileExist [String]
dotfilePaths String
".floskell.json"
    [String]
userPaths <- [IO String] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ String -> IO String
getAppUserDataDirectory String
"floskell"
                          , XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgConfig String
"floskell"
                          ]
    Maybe String
userConfig <- (String -> IO Bool) -> [String] -> String -> IO (Maybe String)
findFileWith String -> IO Bool
doesFileExist [String]
userPaths String
"config.json"
    let localPaths :: [String]
localPaths =
            ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
joinPath ([[String]] -> [String])
-> (String -> [[String]]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [[String]]
forall a. [a] -> [a]
reverse ([[String]] -> [[String]])
-> (String -> [[String]]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[String]] -> [[String]]
forall a. Int -> [a] -> [a]
drop Int
1 ([[String]] -> [[String]])
-> (String -> [[String]]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [[String]]
forall a. [a] -> [[a]]
inits ([String] -> [[String]])
-> (String -> [String]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitDirectories (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$
            String
startFrom
    Maybe String
localConfig <- (String -> IO Bool) -> [String] -> String -> IO (Maybe String)
findFileWith String -> IO Bool
doesFileExist [String]
localPaths String
"floskell.json"
    Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ Maybe String
localConfig Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe String
userConfig Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe String
dotfileConfig

-- | Load a configuration file.
readAppConfig :: FilePath -> IO AppConfig
readAppConfig :: String -> IO AppConfig
readAppConfig String
file = do
    ByteString
text <- String -> IO ByteString
BS.readFile String
file
    (String -> IO AppConfig)
-> (AppConfig -> IO AppConfig)
-> Either String AppConfig
-> IO AppConfig
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> IO AppConfig
forall a. HasCallStack => String -> a
error (String -> IO AppConfig)
-> (String -> String) -> String -> IO AppConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall a. [a] -> [a] -> [a]
(++) (String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": ")) AppConfig -> IO AppConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String AppConfig -> IO AppConfig)
-> Either String AppConfig -> IO AppConfig
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String AppConfig
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict ByteString
text

setStyle :: AppConfig -> Maybe String -> AppConfig
setStyle :: AppConfig -> Maybe String -> AppConfig
setStyle AppConfig
cfg Maybe String
mbStyle =
    AppConfig
cfg { appStyle :: Style
appStyle = Style -> (String -> Style) -> Maybe String -> Style
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AppConfig -> Style
appStyle AppConfig
cfg) String -> Style
lookupStyle Maybe String
mbStyle }

setLanguage :: AppConfig -> Maybe String -> AppConfig
setLanguage :: AppConfig -> Maybe String -> AppConfig
setLanguage AppConfig
cfg Maybe String
mbLanguage =
    AppConfig
cfg { appLanguage :: Language
appLanguage = Language -> (String -> Language) -> Maybe String -> Language
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AppConfig -> Language
appLanguage AppConfig
cfg) String -> Language
lookupLanguage Maybe String
mbLanguage }

setExtensions :: AppConfig -> [String] -> AppConfig
setExtensions :: AppConfig -> [String] -> AppConfig
setExtensions AppConfig
cfg [String]
exts =
    AppConfig
cfg { appExtensions :: [Extension]
appExtensions = AppConfig -> [Extension]
appExtensions AppConfig
cfg [Extension] -> [Extension] -> [Extension]
forall a. [a] -> [a] -> [a]
++ (String -> Extension) -> [String] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map String -> Extension
lookupExtension [String]
exts }

setFixities :: AppConfig -> [String] -> AppConfig
setFixities :: AppConfig -> [String] -> AppConfig
setFixities AppConfig
cfg [String]
fixities =
    AppConfig
cfg { appFixities :: [Fixity]
appFixities = AppConfig -> [Fixity]
appFixities AppConfig
cfg [Fixity] -> [Fixity] -> [Fixity]
forall a. [a] -> [a] -> [a]
++ (String -> Fixity) -> [String] -> [Fixity]
forall a b. (a -> b) -> [a] -> [b]
map String -> Fixity
lookupFixity [String]
fixities }

eitherDecodeStrict :: FromJSON a => BS.ByteString -> Either String a
eitherDecodeStrict :: ByteString -> Either String a
eitherDecodeStrict ByteString
i = case Parser Value -> ByteString -> Either String Value
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser Value
jsonEOF' ByteString
i of
    Right Value
x -> case Value -> Result a
forall a. FromJSON a => Value -> Result a
JSON.fromJSON Value
x of
        JSON.Error String
e -> String -> Either String a
forall a b. a -> Either a b
Left String
e
        JSON.Success a
x' -> a -> Either String a
forall a b. b -> Either a b
Right a
x'
    Left String
e -> String -> Either String a
forall a b. a -> Either a b
Left String
e
  where
    jsonEOF' :: Parser Value
jsonEOF' = Parser Value
JSON.json' Parser Value -> Parser ByteString () -> Parser Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
skipSpace Parser Value -> Parser ByteString () -> Parser Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
AP.endOfInput

    skipSpace :: Parser ByteString ()
skipSpace =
        (Word8 -> Bool) -> Parser ByteString ()
AP.skipWhile ((Word8 -> Bool) -> Parser ByteString ())
-> (Word8 -> Bool) -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ \Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x20 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0a Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0d Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x09