-- | Aeson instances for "small" definitions used in representing Fortran code.

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE OverloadedStrings #-}

module Language.Fortran.Extras.JSON.Supporting() where

import Language.Fortran.Extras.JSON.Helpers
import Language.Fortran.Extras.Util
import Data.Aeson
import Language.Fortran.Util.Position
import Language.Fortran.Version
import Language.Fortran.AST.AList

instance (ToJSON (t a), ToJSON a) => ToJSON (AList t a) where
    toJSON :: AList t a -> Value
toJSON     = Options -> AList t a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> AList t a -> Value) -> Options -> AList t a -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"alist"
    toEncoding :: AList t a -> Encoding
toEncoding = Options -> AList t a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> AList t a -> Encoding)
-> Options -> AList t a -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"alist"
instance (ToJSON a, ToJSON (t1 a), ToJSON (t2 a)) => ToJSON (ATuple t1 t2 a) where
    toJSON :: ATuple t1 t2 a -> Value
toJSON     = Options -> ATuple t1 t2 a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> ATuple t1 t2 a -> Value)
-> Options -> ATuple t1 t2 a -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"atuple"
    toEncoding :: ATuple t1 t2 a -> Encoding
toEncoding = Options -> ATuple t1 t2 a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> ATuple t1 t2 a -> Encoding)
-> Options -> ATuple t1 t2 a -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"atuple"

instance ToJSON FortranVersion where
    toJSON :: FortranVersion -> Value
toJSON     = Options -> FortranVersion -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> FortranVersion -> Value)
-> Options -> FortranVersion -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcEnumDrop String
forall a. Monoid a => a
mempty
    toEncoding :: FortranVersion -> Encoding
toEncoding = Options -> FortranVersion -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> FortranVersion -> Encoding)
-> Options -> FortranVersion -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcEnumDrop String
forall a. Monoid a => a
mempty

instance ToJSON Position where
    toJSON :: Position -> Value
toJSON     = Text -> Value
String (Text -> Value) -> (Position -> Text) -> Position -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Text
forall a. Show a => a -> Text
tshow
    toEncoding :: Position -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Encoding) -> (Position -> Text) -> Position -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Text
forall a. Show a => a -> Text
tshow
instance ToJSON SrcSpan where
    toJSON :: SrcSpan -> Value
toJSON     = Text -> Value
String (Text -> Value) -> (SrcSpan -> Text) -> SrcSpan -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> Text
forall a. Show a => a -> Text
tshow
    toEncoding :: SrcSpan -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Encoding) -> (SrcSpan -> Text) -> SrcSpan -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> Text
forall a. Show a => a -> Text
tshow

{- FromJSON instances

import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer qualified as L
import Data.Void ( Void )
import Data.Text ( Text )
import Data.Functor ( void )

-- TODO better error reporting
instance FromJSON Position where
    parseJSON  = withText "position" $ \t ->
        case parseMaybe pPosition t of
          Nothing  -> fail "failed to parse position"
          Just pos -> pure pos

-- TODO better error reporting
instance FromJSON SrcSpan where
    parseJSON  = withText "SrcSpan" $ \t ->
        case parseMaybe pSrcSpan t of
          Nothing -> fail "failed to parse SrcSpan"
          Just ss -> pure ss

type Parser = Parsec Void Text

pPosition :: Parser Position
pPosition = do
    posLine'   <- L.decimal
    void $ char ':'
    posColumn' <- L.decimal
    return initPosition { posLine = posLine', posColumn = posColumn' }

pSrcSpan :: Parser SrcSpan
pSrcSpan = do
    void $ char '('
    posFrom <- pPosition
    void $ string ")-("
    void $ char ')'
    posTo   <- pPosition
    return $ SrcSpan posFrom posTo

-}