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

-- | Utils and Aeson orphan instances for common types in the AST.
--
-- Partially deprecated by proper JSON serialization support.
module Language.Fortran.Extras.Encoding where

import Language.Fortran.Extras.JSON()
import Data.Aeson ( ToJSON, encode )
import Data.ByteString.Lazy ( ByteString )
import Language.Fortran.PrettyPrint ( IndentablePretty, pprintAndRender )
import Language.Fortran.Version ( FortranVersion(..) )

-- | Provide a wrapper for the 'Data.Aeson.encode' function to allow
-- indirect use in modules importing
-- 'Language.Fortran.Extras.Encoding'.
commonEncode :: ToJSON a => a -> ByteString
commonEncode :: forall a. ToJSON a => a -> ByteString
commonEncode = a -> ByteString
forall a. ToJSON a => a -> ByteString
encode

-- | Render some AST element to a 'String' using F77 legacy mode.
pprint77l :: IndentablePretty a => a -> String
pprint77l :: forall a. IndentablePretty a => a -> String
pprint77l a
s = FortranVersion -> a -> Indentation -> String
forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> String
pprintAndRender FortranVersion
Fortran77Legacy a
s Indentation
forall a. Maybe a
Nothing