{-
   Copyright 2016, Dominic Orchard, Andrew Rice, Mistral Contrastin, Matthew Danish

   Licensed under the Apache License, Version 2.0 (the "License");
   you may not use this file except in compliance with the License.
   You may obtain a copy of the License at

       http://www.apache.org/licenses/LICENSE-2.0

   Unless required by applicable law or agreed to in writing, software
   distributed under the License is distributed on an "AS IS" BASIS,
   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
   See the License for the specific language governing permissions and
   limitations under the License.
-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleContexts #-}

{-|

This module provides a number of helper functions for working with Fortran
syntax that are useful between different analyses and transformations.

-}
module Camfort.Helpers.Syntax
  (
  -- * Variable renaming helpers
    caml
  -- * Comparison and ordering
  , AnnotationFree(..)
  , af
  -- * Accessor functions for extracting various pieces of information
  --   out of syntax trees
  , extractVariable
  -- * SrcSpan Helpers
  , afterAligned
  , deleteLine
  , dropLine
  , linesCovered
  , toCol0
  ) where

-- Standard imports
import Data.Char
import qualified Data.Semigroup as SG

-- Data-type generics imports
import Data.Generics.Uniplate.Data

import qualified Language.Fortran.AST as F
import qualified Language.Fortran.Analysis as FA
import qualified Language.Fortran.Util.Position as FU

-- * Comparison and ordering

{-|  'AnnotationFree' is a data type that wraps other types and denotes terms
     which should  be compared for equality modulo their annotations and source
     location information -}
data AnnotationFree t = AnnotationFree { AnnotationFree t -> t
annotationBound :: t } deriving Int -> AnnotationFree t -> ShowS
[AnnotationFree t] -> ShowS
AnnotationFree t -> String
(Int -> AnnotationFree t -> ShowS)
-> (AnnotationFree t -> String)
-> ([AnnotationFree t] -> ShowS)
-> Show (AnnotationFree t)
forall t. Show t => Int -> AnnotationFree t -> ShowS
forall t. Show t => [AnnotationFree t] -> ShowS
forall t. Show t => AnnotationFree t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnnotationFree t] -> ShowS
$cshowList :: forall t. Show t => [AnnotationFree t] -> ShowS
show :: AnnotationFree t -> String
$cshow :: forall t. Show t => AnnotationFree t -> String
showsPrec :: Int -> AnnotationFree t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> AnnotationFree t -> ShowS
Show

{-| short-hand constructor for 'AnnotationFree' -}
af :: t -> AnnotationFree t
af :: t -> AnnotationFree t
af = t -> AnnotationFree t
forall t. t -> AnnotationFree t
AnnotationFree

-- variable renaming helpers
caml :: [Char] -> [Char]
caml :: ShowS
caml (Char
x:String
xs) = Char -> Char
toUpper Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs
caml []     = []

-- Here begins varioous 'Eq' instances for instantiations of 'AnnotationFree'

instance Eq (AnnotationFree a) => Eq (AnnotationFree [a]) where
    (AnnotationFree [a]
xs) == :: AnnotationFree [a] -> AnnotationFree [a] -> Bool
== (AnnotationFree [a]
xs') =
     if [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs'
     then (Bool -> (a, a) -> Bool) -> Bool -> [(a, a)] -> Bool
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Bool
b (a
x, a
x') -> (a -> AnnotationFree a
forall t. t -> AnnotationFree t
af a
x AnnotationFree a -> AnnotationFree a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> AnnotationFree a
forall t. t -> AnnotationFree t
af a
x') Bool -> Bool -> Bool
&& Bool
b) Bool
True ([a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs [a]
xs')
     else Bool
False

instance (Eq (AnnotationFree a), Eq (AnnotationFree b))
      => Eq (AnnotationFree (a, b)) where

    (AnnotationFree (a
x, b
y)) == :: AnnotationFree (a, b) -> AnnotationFree (a, b) -> Bool
== (AnnotationFree (a
x', b
y')) =
        (a -> AnnotationFree a
forall t. t -> AnnotationFree t
af a
x AnnotationFree a -> AnnotationFree a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> AnnotationFree a
forall t. t -> AnnotationFree t
af a
x') Bool -> Bool -> Bool
&& (b -> AnnotationFree b
forall t. t -> AnnotationFree t
af b
y AnnotationFree b -> AnnotationFree b -> Bool
forall a. Eq a => a -> a -> Bool
== b -> AnnotationFree b
forall t. t -> AnnotationFree t
af b
y')

instance Eq a => Eq (AnnotationFree (F.Expression a)) where
    (AnnotationFree Expression a
x) == :: AnnotationFree (Expression a)
-> AnnotationFree (Expression a) -> Bool
== (AnnotationFree Expression a
y) = Expression ()
x'' Expression () -> Expression () -> Bool
forall a. Eq a => a -> a -> Bool
== Expression ()
y''
        where x' :: Expression ()
x' = (a -> ()) -> Expression a -> Expression ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> a -> ()
forall a b. a -> b -> a
const ()) Expression a
x
              y' :: Expression ()
y' = (a -> ()) -> Expression a -> Expression ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> a -> ()
forall a b. a -> b -> a
const ()) Expression a
y
              y'' :: Expression ()
y'' = (SrcSpan -> SrcSpan) -> Expression () -> Expression ()
forall from to. Biplate from to => (to -> to) -> from -> from
transformBi SrcSpan -> SrcSpan
setSpanConst Expression ()
y'
              x'' :: Expression ()
x'' = (SrcSpan -> SrcSpan) -> Expression () -> Expression ()
forall from to. Biplate from to => (to -> to) -> from -> from
transformBi SrcSpan -> SrcSpan
setSpanConst Expression ()
x'
              setSpanConst :: FU.SrcSpan -> FU.SrcSpan
              setSpanConst :: SrcSpan -> SrcSpan
setSpanConst (FU.SrcSpan Position
_ Position
_) = Position -> Position -> SrcSpan
FU.SrcSpan Position
pos0 Position
pos0
                 where pos0 :: Position
pos0 = Int -> Int -> Int -> String -> Maybe (Int, String) -> Position
FU.Position Int
0 Int
0 Int
0 String
"" Maybe (Int, String)
forall a. Maybe a
Nothing

instance Eq (AnnotationFree F.BaseType) where
    (AnnotationFree BaseType
x) == :: AnnotationFree BaseType -> AnnotationFree BaseType -> Bool
== (AnnotationFree BaseType
y) = BaseType
x BaseType -> BaseType -> Bool
forall a. Eq a => a -> a -> Bool
== BaseType
y

instance Eq (AnnotationFree FA.ConstructType) where
    (AnnotationFree ConstructType
x) == :: AnnotationFree ConstructType
-> AnnotationFree ConstructType -> Bool
== (AnnotationFree ConstructType
y) = ConstructType
x ConstructType -> ConstructType -> Bool
forall a. Eq a => a -> a -> Bool
== ConstructType
y

-- * Accessor functions for extracting various pieces of information
--    out of syntax trees
{-| Extracts a string of the (root) variable name from an expression,
    e.g., extractVariable "v"    = Just v
          extractVariable "v(i)" = Just v -}
extractVariable :: F.Expression a -> Maybe F.Name
extractVariable :: Expression a -> Maybe String
extractVariable (F.ExpValue a
_ SrcSpan
_ (F.ValVariable String
v)) = String -> Maybe String
forall a. a -> Maybe a
Just String
v
extractVariable (F.ExpSubscript a
_ SrcSpan
_ Expression a
e AList Index a
_)           = Expression a -> Maybe String
forall a. Expression a -> Maybe String
extractVariable Expression a
e
extractVariable Expression a
_                                  = Maybe String
forall a. Maybe a
Nothing

instance SG.Semigroup Int where
  <> :: Int -> Int -> Int
(<>) = Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)

{-| Set a default monoid instances for Int -}
instance Monoid Int where
    mempty :: Int
mempty = Int
0
    mappend :: Int -> Int -> Int
mappend = Int -> Int -> Int
forall a. Semigroup a => a -> a -> a
(SG.<>)

-- SrcSpan helpers

dropLine :: FU.SrcSpan -> FU.SrcSpan
dropLine :: SrcSpan -> SrcSpan
dropLine (FU.SrcSpan Position
s1 (FU.Position Int
o Int
_ Int
l String
f Maybe (Int, String)
po)) =
    Position -> Position -> SrcSpan
FU.SrcSpan Position
s1 (Int -> Int -> Int -> String -> Maybe (Int, String) -> Position
FU.Position Int
o Int
1 (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
f Maybe (Int, String)
po)

deleteLine :: FU.SrcSpan -> FU.SrcSpan
deleteLine :: SrcSpan -> SrcSpan
deleteLine (FU.SrcSpan (FU.Position Int
ol Int
cl Int
ll String
fl Maybe (Int, String)
pl) (FU.Position Int
ou Int
_ Int
lu String
fu Maybe (Int, String)
pu)) =
    Position -> Position -> SrcSpan
FU.SrcSpan (Int -> Int -> Int -> String -> Maybe (Int, String) -> Position
FU.Position Int
ol (Int
clInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
ll String
fl Maybe (Int, String)
pl) (Int -> Int -> Int -> String -> Maybe (Int, String) -> Position
FU.Position Int
ou Int
1 (Int
luInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
fu Maybe (Int, String)
pu)

linesCovered :: FU.Position -> FU.Position -> Int
linesCovered :: Position -> Position -> Int
linesCovered (FU.Position Int
_ Int
_ Int
l1 String
_ Maybe (Int, String)
_) (FU.Position Int
_ Int
_ Int
l2 String
_ Maybe (Int, String)
_) = Int
l2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

toCol0 :: FU.Position -> FU.Position
toCol0 :: Position -> Position
toCol0 (FU.Position Int
o Int
_ Int
l String
f Maybe (Int, String)
p) = Int -> Int -> Int -> String -> Maybe (Int, String) -> Position
FU.Position Int
o Int
1 Int
l String
f Maybe (Int, String)
p

afterAligned :: FU.SrcSpan -> FU.Position
afterAligned :: SrcSpan -> Position
afterAligned (FU.SrcSpan (FU.Position Int
o Int
cA Int
_ String
f Maybe (Int, String)
p) (FU.Position Int
_ Int
_ Int
lB String
_ Maybe (Int, String)
_)) =
    Int -> Int -> Int -> String -> Maybe (Int, String) -> Position
FU.Position Int
o Int
cA (Int
lBInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
f Maybe (Int, String)
p