content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE RankNTypes #-}
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE ExtendedDefaultRules #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE PackageImports #-}
  {-# LANGUAGE RankNTypes #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TypeFamilies #-}
  
  -- | Definitions common to frontend and backend.
  --
  --   And commonly used imports.
  
  module Common.Foundation
    ( -- * Aeson encodings
      compactEncoding
      -- * Lenses and Prisms
    , makePactLenses
    , makePactLensesNonClassy
    , makePactPrisms
    , _PLit
    , _PGuard
    , _GKeySet
      -- * Helpers that should really not be here
    , tshow
    , tread
    , prettyTextCompact
    , prettyTextPretty
    , note
    , safeDecodeUtf8
    , someTag
    , upsert
    , foldMapM
    , (<$$>)
    , (<$$$>)
      -- * Re-exports
    , module Data.Bool
    , module Data.Maybe
    , module Data.Semigroup
    , module Data.Foldable
    , module Control.Monad.IO.Class
    , module Control.Monad.Fix
    , module GHC.Generics
    ) where
  
  import           Control.Lens
  import           Control.Monad.Except                  (MonadError, throwError)
  import           Control.Monad.Fix
  import           Control.Monad.IO.Class
  import           Data.Aeson                            as A
  import           Data.Bool
  import           Data.ByteString                       (ByteString)
  import           Data.Dependent.Sum (DSum(..))
  import           Data.Foldable
  import qualified Data.List.Split                       as L
  import           Data.Semigroup
  import           Data.Some (Some(Some))
  import           Data.Text                             (Text)
  import qualified Data.Text                             as T
  import qualified Data.Text.Encoding                    as T
  import qualified Data.Text.Encoding.Error              as T
  import           GHC.Generics                          (Generic)
  import "template-haskell" Language.Haskell.TH
  
  import           Data.Maybe                            hiding (mapMaybe)
  
  import qualified Data.Text.Prettyprint.Doc             as Pretty (defaultLayoutOptions,
                                                                    layoutCompact,
                                                                    layoutPretty)
  import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty
  import qualified Pact.Types.Pretty                     as Pretty
  import qualified Pact.Types.PactValue                  as Pact
  import qualified Pact.Types.Term                       as Pact
  import qualified Pact.Types.Exp                        as Pact
  import           Text.Read                             as T
  
  
  infixl 4 <$$>
  (<$$>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
  f <$$> a = fmap f <$> a
  
  infixl 4 <$$$>
  (<$$$>) :: (Functor f, Functor g, Functor h) => (a -> b) -> f (g (h a)) -> f (g (h b))
  f <$$$> a = fmap f <$$> a
  
  -- | Aeson encoding options for compact encoding.
  --
  --   We pass on the most compact sumEncoding as it could be unsound for certain types.
  --
  --   But we assume the following naming of constructor names (sum typs) and
  --   field names (records): _TypeName_Blah and _typename_blah.
  --
  --   In particular we assume that only the string after the last underscore is
  --   significant for distinguishing field names/constructor names. If this
  --   assumption is not met this encoding might not result in the same decoding.
  compactEncoding :: A.Options
  compactEncoding = defaultOptions
      { fieldLabelModifier = shortener
      , allNullaryToStringTag = True
      , constructorTagModifier = shortener
      , omitNothingFields = True
      , sumEncoding = ObjectWithSingleField
      , unwrapUnaryRecords = True
      , tagSingleConstructors = False
      }
    where
      -- As long as names are not empty or just underscores this head should be fine:
      shortener = head . reverse . filter (/= "") . L.splitOn "_"
  
  tshow :: Show a => a -> Text
  tshow = T.pack . show
  
  tread :: Read a => Text -> Maybe a
  tread = T.readMaybe . T.unpack
  
  prettyTextCompact :: Pretty.Pretty a => a -> Text
  prettyTextCompact = Pretty.renderStrict . Pretty.layoutCompact . Pretty.pretty
  
  prettyTextPretty :: Pretty.Pretty a => a -> Text
  prettyTextPretty = Pretty.renderStrict . Pretty.layoutPretty Pretty.defaultLayoutOptions . Pretty.pretty
  
  note :: MonadError e m => e -> Maybe a -> m a
  note e = maybe (throwError e) pure
  
  safeDecodeUtf8 :: ByteString -> Text
  safeDecodeUtf8 = T.decodeUtf8With T.lenientDecode
  
  someTag :: DSum tag f -> Some tag
  someTag (tag :=> _) = Some tag
  
  -- | Lenses in this project should be generated by means of this function.
  --
  --   We generate lazy classy lenses. Classes make the export lists less tedious
  --   and allows for generic code, which will come in handy when the project
  --   grows.
  --
  --   We want lazy lenses so we can uses lenses also in recursive definitions.
  
  makePactLenses :: Name -> DecsQ
  makePactLenses =
    makeLensesWith
      ( classyRules
          & generateLazyPatterns .~ True
          & createClass .~ True
      )
  
  -- | Non classy non simple lenses.
  --
  --   For some reason ( I have not investigated yet ), classy non simple lenses
  --   don't seem to work properly, at least not if the type has parameters.
  --   Therefore if you have a type where you need non simple lenses (lenses that
  --   can change the type), you have to use this function instead of
  --   `makePactLenses`.
  makePactLensesNonClassy :: Name -> DecsQ
  makePactLensesNonClassy =
    makeLensesWith
      ( lensRules
          & simpleLenses .~ False
          & generateLazyPatterns .~ True
      )
  
  -- | Make Prisms in "pact style".
  --
  --   Currently this is just standard `makePrisms`
  makePactPrisms :: Name -> DecsQ
  makePactPrisms = makePrisms
  
  _PGuard :: Prism' Pact.PactValue (Pact.Guard Pact.PactValue)
  _PGuard = prism' Pact.PGuard (\case (Pact.PGuard g) -> Just g; _ -> Nothing)
  
  _GKeySet :: Prism' (Pact.Guard Pact.PactValue) Pact.KeySet
  _GKeySet = prism' Pact.GKeySet (\case (Pact.GKeySet ks) -> Just ks; _ -> Nothing)
  
  _PLit :: Prism' Pact.PactValue Pact.Literal
  _PLit = prism' Pact.PLiteral (\case (Pact.PLiteral l) -> Just l; _ -> Nothing)
  
  -- | Upsert a value using the given default
  upsert :: At x => Index x -> IxValue x -> Lens' x (IxValue x)
  upsert idx x = at idx . iso (fromMaybe x) Just
  
  -- | Extend 'foldMap' to allow side effects.
  -- Implementation taken from rio: https://hackage.haskell.org/package/rio-0.1.13.0/docs/RIO-Prelude.html#v:foldMapM
  foldMapM
    :: (Monad m, Monoid w, Foldable t)
    => (a -> m w)
    -> t a
    -> m w
  foldMapM f = foldlM
    (\acc a -> do
      w <- f a
      return $! mappend acc w)
    mempty
  