{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
module Hedgehog.Internal.Discovery (
    PropertySource(..)
  , readProperties
  , findProperties
  , readDeclaration

  , Pos(..)
  , Position(..)
  ) where

import           Control.Exception (IOException, handle)
import           Control.Monad.IO.Class (MonadIO(..))

import qualified Data.Char as Char
import qualified Data.List as List
import           Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Ord as Ord

import           Hedgehog.Internal.Property (PropertyName(..))
import           Hedgehog.Internal.Source (LineNo(..), ColumnNo(..))

#if __GLASGOW_HASKELL__ < 808
import           Data.Semigroup (Semigroup(..))
#endif

------------------------------------------------------------------------
-- Property Extraction

newtype PropertySource =
  PropertySource {
      PropertySource -> Pos String
propertySource :: Pos String
    } deriving (PropertySource -> PropertySource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PropertySource -> PropertySource -> Bool
$c/= :: PropertySource -> PropertySource -> Bool
== :: PropertySource -> PropertySource -> Bool
$c== :: PropertySource -> PropertySource -> Bool
Eq, Eq PropertySource
PropertySource -> PropertySource -> Bool
PropertySource -> PropertySource -> Ordering
PropertySource -> PropertySource -> PropertySource
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PropertySource -> PropertySource -> PropertySource
$cmin :: PropertySource -> PropertySource -> PropertySource
max :: PropertySource -> PropertySource -> PropertySource
$cmax :: PropertySource -> PropertySource -> PropertySource
>= :: PropertySource -> PropertySource -> Bool
$c>= :: PropertySource -> PropertySource -> Bool
> :: PropertySource -> PropertySource -> Bool
$c> :: PropertySource -> PropertySource -> Bool
<= :: PropertySource -> PropertySource -> Bool
$c<= :: PropertySource -> PropertySource -> Bool
< :: PropertySource -> PropertySource -> Bool
$c< :: PropertySource -> PropertySource -> Bool
compare :: PropertySource -> PropertySource -> Ordering
$ccompare :: PropertySource -> PropertySource -> Ordering
Ord, Int -> PropertySource -> ShowS
[PropertySource] -> ShowS
PropertySource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PropertySource] -> ShowS
$cshowList :: [PropertySource] -> ShowS
show :: PropertySource -> String
$cshow :: PropertySource -> String
showsPrec :: Int -> PropertySource -> ShowS
$cshowsPrec :: Int -> PropertySource -> ShowS
Show)

readProperties :: MonadIO m => String -> FilePath -> m (Map PropertyName PropertySource)
readProperties :: forall (m :: * -> *).
MonadIO m =>
String -> String -> m (Map PropertyName PropertySource)
readProperties String
prefix String
path =
  String -> String -> String -> Map PropertyName PropertySource
findProperties String
prefix String
path forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO String
readFile String
path)

readDeclaration :: MonadIO m => FilePath -> LineNo -> m (Maybe (String, Pos String))
readDeclaration :: forall (m :: * -> *).
MonadIO m =>
String -> LineNo -> m (Maybe (String, Pos String))
readDeclaration String
path LineNo
line = do
  Maybe String
mfile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => String -> m (Maybe String)
readFileSafe String
path
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ do
    String
file <- Maybe String
mfile
    forall a. [a] -> Maybe a
takeHead forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Ord.comparing forall a b. (a -> b) -> a -> b
$ forall a. a -> Down a
Ord.Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> LineNo
posLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pos a -> Position
posPostion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
<= LineNo
line) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> LineNo
posLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pos a -> Position
posPostion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
      forall k a. Map k a -> [(k, a)]
Map.toList (String -> String -> Map String (Pos String)
findDeclarations String
path String
file)

readFileSafe :: MonadIO m => FilePath -> m (Maybe String)
readFileSafe :: forall (m :: * -> *). MonadIO m => String -> m (Maybe String)
readFileSafe String
path =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(IOException
_ :: IOException) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
path)

takeHead :: [a] -> Maybe a
takeHead :: forall a. [a] -> Maybe a
takeHead = \case
  [] ->
    forall a. Maybe a
Nothing
  a
x : [a]
_ ->
    forall a. a -> Maybe a
Just a
x

findProperties :: String -> FilePath -> String -> Map PropertyName PropertySource
findProperties :: String -> String -> String -> Map PropertyName PropertySource
findProperties String
prefix String
path =
  forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Pos String -> PropertySource
PropertySource forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic String -> PropertyName
PropertyName forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\String
k Pos String
_ -> forall a. Eq a => [a] -> [a] -> Bool
List.isPrefixOf String
prefix String
k) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  String -> String -> Map String (Pos String)
findDeclarations String
path

findDeclarations :: FilePath -> String -> Map String (Pos String)
findDeclarations :: String -> String -> Map String (Pos String)
findDeclarations String
path =
  [Classified (Pos Char)] -> Map String (Pos String)
declarations forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  [Pos Char] -> [Classified (Pos Char)]
classified forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  String -> String -> [Pos Char]
positioned String
path

------------------------------------------------------------------------
-- Declaration Identification

declarations :: [Classified (Pos Char)] -> Map String (Pos String)
declarations :: [Classified (Pos Char)] -> Map String (Pos String)
declarations =
  let
    loop :: [Classified (Pos Char)] -> [(String, Pos String)]
loop = \case
      [] ->
        []
      Classified (Pos Char)
x : [Classified (Pos Char)]
xs ->
        let
          ([Classified (Pos Char)]
ys, [Classified (Pos Char)]
zs) =
            forall a. (a -> Bool) -> [a] -> ([a], [a])
break Classified (Pos Char) -> Bool
isDeclaration [Classified (Pos Char)]
xs
        in
          Pos String -> (String, Pos String)
tagWithName (Classified (Pos Char) -> [Classified (Pos Char)] -> Pos String
forget Classified (Pos Char)
x forall a b. (a -> b) -> a -> b
$ [Classified (Pos Char)] -> [Classified (Pos Char)]
trimEnd [Classified (Pos Char)]
ys) forall a. a -> [a] -> [a]
: [Classified (Pos Char)] -> [(String, Pos String)]
loop [Classified (Pos Char)]
zs
  in
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Classified (Pos Char)] -> [(String, Pos String)]
loop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Classified (Pos Char) -> Bool
isDeclaration)

trimEnd :: [Classified (Pos Char)] -> [Classified (Pos Char)]
trimEnd :: [Classified (Pos Char)] -> [Classified (Pos Char)]
trimEnd [Classified (Pos Char)]
xs =
  let
    ([Classified (Pos Char)]
space0, [Classified (Pos Char)]
code) =
      forall a. (a -> Bool) -> [a] -> ([a], [a])
span Classified (Pos Char) -> Bool
isWhitespace forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Classified (Pos Char)]
xs

    ([Classified (Pos Char)]
line_tail0, [Classified (Pos Char)]
space) =
      forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\(Classified Class
_ (Pos Position
_ Char
x)) -> Char
x forall a. Eq a => a -> a -> Bool
/= Char
'\n') forall a b. (a -> b) -> a -> b
$
      forall a. [a] -> [a]
reverse [Classified (Pos Char)]
space0

    line_tail :: [Classified (Pos Char)]
line_tail =
      case [Classified (Pos Char)]
space of
        [] ->
          [Classified (Pos Char)]
line_tail0
        Classified (Pos Char)
x : [Classified (Pos Char)]
_ ->
          [Classified (Pos Char)]
line_tail0 forall a. [a] -> [a] -> [a]
++ [Classified (Pos Char)
x]
  in
    forall a. [a] -> [a]
reverse [Classified (Pos Char)]
code forall a. [a] -> [a] -> [a]
++ [Classified (Pos Char)]
line_tail

isWhitespace :: Classified (Pos Char) -> Bool
isWhitespace :: Classified (Pos Char) -> Bool
isWhitespace (Classified Class
c (Pos Position
_ Char
x)) =
  Class
c forall a. Eq a => a -> a -> Bool
== Class
Comment Bool -> Bool -> Bool
||
  Char -> Bool
Char.isSpace Char
x

tagWithName :: Pos String -> (String, Pos String)
tagWithName :: Pos String -> (String, Pos String)
tagWithName (Pos Position
p String
x) =
  (ShowS
takeName String
x, forall a. Position -> a -> Pos a
Pos Position
p String
x)

takeName :: String -> String
takeName :: ShowS
takeName String
xs =
  case String -> [String]
words String
xs of
    [] ->
      String
""
    String
x : [String]
_ ->
      String
x

forget :: Classified (Pos Char) -> [Classified (Pos Char)] -> Pos String
forget :: Classified (Pos Char) -> [Classified (Pos Char)] -> Pos String
forget (Classified Class
_ (Pos Position
p Char
x)) [Classified (Pos Char)]
xs =
  forall a. Position -> a -> Pos a
Pos Position
p forall a b. (a -> b) -> a -> b
$
    Char
x forall a. a -> [a] -> [a]
: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Pos a -> a
posValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Classified a -> a
classifiedValue) [Classified (Pos Char)]
xs

isDeclaration :: Classified (Pos Char) -> Bool
isDeclaration :: Classified (Pos Char) -> Bool
isDeclaration (Classified Class
c (Pos Position
p Char
x)) =
  Class
c forall a. Eq a => a -> a -> Bool
== Class
NotComment Bool -> Bool -> Bool
&&
  Position -> ColumnNo
posColumn Position
p forall a. Eq a => a -> a -> Bool
== ColumnNo
1 Bool -> Bool -> Bool
&&
  (Char -> Bool
Char.isLower Char
x Bool -> Bool -> Bool
|| Char
x forall a. Eq a => a -> a -> Bool
== Char
'_')

------------------------------------------------------------------------
-- Comment Classification

data Class =
    NotComment
  | Comment
    deriving (Class -> Class -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Class -> Class -> Bool
$c/= :: Class -> Class -> Bool
== :: Class -> Class -> Bool
$c== :: Class -> Class -> Bool
Eq, Eq Class
Class -> Class -> Bool
Class -> Class -> Ordering
Class -> Class -> Class
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Class -> Class -> Class
$cmin :: Class -> Class -> Class
max :: Class -> Class -> Class
$cmax :: Class -> Class -> Class
>= :: Class -> Class -> Bool
$c>= :: Class -> Class -> Bool
> :: Class -> Class -> Bool
$c> :: Class -> Class -> Bool
<= :: Class -> Class -> Bool
$c<= :: Class -> Class -> Bool
< :: Class -> Class -> Bool
$c< :: Class -> Class -> Bool
compare :: Class -> Class -> Ordering
$ccompare :: Class -> Class -> Ordering
Ord, Int -> Class -> ShowS
[Class] -> ShowS
Class -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Class] -> ShowS
$cshowList :: [Class] -> ShowS
show :: Class -> String
$cshow :: Class -> String
showsPrec :: Int -> Class -> ShowS
$cshowsPrec :: Int -> Class -> ShowS
Show)

data Classified a =
  Classified {
      forall a. Classified a -> Class
_classifiedClass :: !Class
    , forall a. Classified a -> a
classifiedValue :: !a
    } deriving (Classified a -> Classified a -> Bool
forall a. Eq a => Classified a -> Classified a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Classified a -> Classified a -> Bool
$c/= :: forall a. Eq a => Classified a -> Classified a -> Bool
== :: Classified a -> Classified a -> Bool
$c== :: forall a. Eq a => Classified a -> Classified a -> Bool
Eq, Classified a -> Classified a -> Bool
Classified a -> Classified a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Classified a)
forall a. Ord a => Classified a -> Classified a -> Bool
forall a. Ord a => Classified a -> Classified a -> Ordering
forall a. Ord a => Classified a -> Classified a -> Classified a
min :: Classified a -> Classified a -> Classified a
$cmin :: forall a. Ord a => Classified a -> Classified a -> Classified a
max :: Classified a -> Classified a -> Classified a
$cmax :: forall a. Ord a => Classified a -> Classified a -> Classified a
>= :: Classified a -> Classified a -> Bool
$c>= :: forall a. Ord a => Classified a -> Classified a -> Bool
> :: Classified a -> Classified a -> Bool
$c> :: forall a. Ord a => Classified a -> Classified a -> Bool
<= :: Classified a -> Classified a -> Bool
$c<= :: forall a. Ord a => Classified a -> Classified a -> Bool
< :: Classified a -> Classified a -> Bool
$c< :: forall a. Ord a => Classified a -> Classified a -> Bool
compare :: Classified a -> Classified a -> Ordering
$ccompare :: forall a. Ord a => Classified a -> Classified a -> Ordering
Ord, Int -> Classified a -> ShowS
forall a. Show a => Int -> Classified a -> ShowS
forall a. Show a => [Classified a] -> ShowS
forall a. Show a => Classified a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Classified a] -> ShowS
$cshowList :: forall a. Show a => [Classified a] -> ShowS
show :: Classified a -> String
$cshow :: forall a. Show a => Classified a -> String
showsPrec :: Int -> Classified a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Classified a -> ShowS
Show)

classified :: [Pos Char] -> [Classified (Pos Char)]
classified :: [Pos Char] -> [Classified (Pos Char)]
classified =
  let
    ok :: a -> Classified a
ok =
      forall a. Class -> a -> Classified a
Classified Class
NotComment

    ko :: a -> Classified a
ko =
      forall a. Class -> a -> Classified a
Classified Class
Comment

    loop :: a -> Bool -> [Pos Char] -> [Classified (Pos Char)]
loop a
nesting Bool
in_line = \case
      [] ->
        []

      x :: Pos Char
x@(Pos Position
_ Char
'\n') : [Pos Char]
xs | Bool
in_line ->
        forall {a}. a -> Classified a
ok Pos Char
x forall a. a -> [a] -> [a]
: a -> Bool -> [Pos Char] -> [Classified (Pos Char)]
loop a
nesting Bool
False [Pos Char]
xs

      Pos Char
x : [Pos Char]
xs | Bool
in_line ->
        forall {a}. a -> Classified a
ko Pos Char
x forall a. a -> [a] -> [a]
: a -> Bool -> [Pos Char] -> [Classified (Pos Char)]
loop a
nesting Bool
in_line [Pos Char]
xs

      x :: Pos Char
x@(Pos Position
_ Char
'{') : y :: Pos Char
y@(Pos Position
_ Char
'-') : [Pos Char]
xs ->
        forall {a}. a -> Classified a
ko Pos Char
x forall a. a -> [a] -> [a]
: forall {a}. a -> Classified a
ko Pos Char
y forall a. a -> [a] -> [a]
: a -> Bool -> [Pos Char] -> [Classified (Pos Char)]
loop (a
nesting forall a. Num a => a -> a -> a
+ a
1) Bool
in_line [Pos Char]
xs

      x :: Pos Char
x@(Pos Position
_ Char
'-') : y :: Pos Char
y@(Pos Position
_ Char
'}') : [Pos Char]
xs | a
nesting forall a. Ord a => a -> a -> Bool
> a
0 ->
        forall {a}. a -> Classified a
ko Pos Char
x forall a. a -> [a] -> [a]
: forall {a}. a -> Classified a
ko Pos Char
y forall a. a -> [a] -> [a]
: a -> Bool -> [Pos Char] -> [Classified (Pos Char)]
loop (a
nesting forall a. Num a => a -> a -> a
- a
1) Bool
in_line [Pos Char]
xs

      Pos Char
x : [Pos Char]
xs | a
nesting forall a. Ord a => a -> a -> Bool
> a
0 ->
        forall {a}. a -> Classified a
ko Pos Char
x forall a. a -> [a] -> [a]
: a -> Bool -> [Pos Char] -> [Classified (Pos Char)]
loop a
nesting Bool
in_line [Pos Char]
xs

      -- FIXME This is not technically correct, we should allow arbitrary runs
      -- FIXME of dashes followed by a symbol character. Here we have only
      -- FIXME allowed two.
      x :: Pos Char
x@(Pos Position
_ Char
'-') : y :: Pos Char
y@(Pos Position
_ Char
'-') : z :: Pos Char
z@(Pos Position
_ Char
zz) : [Pos Char]
xs
        | Bool -> Bool
not (Char -> Bool
Char.isSymbol Char
zz)
        ->
          forall {a}. a -> Classified a
ko Pos Char
x forall a. a -> [a] -> [a]
: forall {a}. a -> Classified a
ko Pos Char
y forall a. a -> [a] -> [a]
: a -> Bool -> [Pos Char] -> [Classified (Pos Char)]
loop a
nesting Bool
True (Pos Char
z forall a. a -> [a] -> [a]
: [Pos Char]
xs)

      Pos Char
x : [Pos Char]
xs ->
        forall {a}. a -> Classified a
ok Pos Char
x forall a. a -> [a] -> [a]
: a -> Bool -> [Pos Char] -> [Classified (Pos Char)]
loop a
nesting Bool
in_line [Pos Char]
xs
  in
    forall {a}.
(Num a, Ord a) =>
a -> Bool -> [Pos Char] -> [Classified (Pos Char)]
loop (Int
0 :: Int) Bool
False

------------------------------------------------------------------------
-- Character Positioning

data Position =
  Position {
      Position -> String
_posPath :: !FilePath
    , Position -> LineNo
posLine :: !LineNo
    , Position -> ColumnNo
posColumn :: !ColumnNo
    } deriving (Position -> Position -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c== :: Position -> Position -> Bool
Eq, Eq Position
Position -> Position -> Bool
Position -> Position -> Ordering
Position -> Position -> Position
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmax :: Position -> Position -> Position
>= :: Position -> Position -> Bool
$c>= :: Position -> Position -> Bool
> :: Position -> Position -> Bool
$c> :: Position -> Position -> Bool
<= :: Position -> Position -> Bool
$c<= :: Position -> Position -> Bool
< :: Position -> Position -> Bool
$c< :: Position -> Position -> Bool
compare :: Position -> Position -> Ordering
$ccompare :: Position -> Position -> Ordering
Ord, Int -> Position -> ShowS
[Position] -> ShowS
Position -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Position] -> ShowS
$cshowList :: [Position] -> ShowS
show :: Position -> String
$cshow :: Position -> String
showsPrec :: Int -> Position -> ShowS
$cshowsPrec :: Int -> Position -> ShowS
Show)

data Pos a =
  Pos {
      forall a. Pos a -> Position
posPostion :: !Position
    , forall a. Pos a -> a
posValue :: a
    } deriving (Pos a -> Pos a -> Bool
forall a. Eq a => Pos a -> Pos a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pos a -> Pos a -> Bool
$c/= :: forall a. Eq a => Pos a -> Pos a -> Bool
== :: Pos a -> Pos a -> Bool
$c== :: forall a. Eq a => Pos a -> Pos a -> Bool
Eq, Pos a -> Pos a -> Bool
Pos a -> Pos a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Pos a)
forall a. Ord a => Pos a -> Pos a -> Bool
forall a. Ord a => Pos a -> Pos a -> Ordering
forall a. Ord a => Pos a -> Pos a -> Pos a
min :: Pos a -> Pos a -> Pos a
$cmin :: forall a. Ord a => Pos a -> Pos a -> Pos a
max :: Pos a -> Pos a -> Pos a
$cmax :: forall a. Ord a => Pos a -> Pos a -> Pos a
>= :: Pos a -> Pos a -> Bool
$c>= :: forall a. Ord a => Pos a -> Pos a -> Bool
> :: Pos a -> Pos a -> Bool
$c> :: forall a. Ord a => Pos a -> Pos a -> Bool
<= :: Pos a -> Pos a -> Bool
$c<= :: forall a. Ord a => Pos a -> Pos a -> Bool
< :: Pos a -> Pos a -> Bool
$c< :: forall a. Ord a => Pos a -> Pos a -> Bool
compare :: Pos a -> Pos a -> Ordering
$ccompare :: forall a. Ord a => Pos a -> Pos a -> Ordering
Ord, Int -> Pos a -> ShowS
forall a. Show a => Int -> Pos a -> ShowS
forall a. Show a => [Pos a] -> ShowS
forall a. Show a => Pos a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pos a] -> ShowS
$cshowList :: forall a. Show a => [Pos a] -> ShowS
show :: Pos a -> String
$cshow :: forall a. Show a => Pos a -> String
showsPrec :: Int -> Pos a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Pos a -> ShowS
Show, forall a b. a -> Pos b -> Pos a
forall a b. (a -> b) -> Pos a -> Pos b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Pos b -> Pos a
$c<$ :: forall a b. a -> Pos b -> Pos a
fmap :: forall a b. (a -> b) -> Pos a -> Pos b
$cfmap :: forall a b. (a -> b) -> Pos a -> Pos b
Functor)

instance Semigroup a => Semigroup (Pos a) where
  <> :: Pos a -> Pos a -> Pos a
(<>) (Pos Position
p a
x) (Pos Position
q a
y) =
    if Position
p forall a. Ord a => a -> a -> Bool
< Position
q then
      forall a. Position -> a -> Pos a
Pos Position
p (a
x forall a. Semigroup a => a -> a -> a
<> a
y)
    else
      forall a. Position -> a -> Pos a
Pos Position
q (a
y forall a. Semigroup a => a -> a -> a
<> a
x)

positioned :: FilePath -> [Char] -> [Pos Char]
positioned :: String -> String -> [Pos Char]
positioned String
path =
  let
    loop :: LineNo -> ColumnNo -> String -> [Pos Char]
loop LineNo
l ColumnNo
c = \case
      [] ->
        []

      Char
'\n' : String
xs ->
        forall a. Position -> a -> Pos a
Pos (String -> LineNo -> ColumnNo -> Position
Position String
path LineNo
l ColumnNo
c) Char
'\n' forall a. a -> [a] -> [a]
: LineNo -> ColumnNo -> String -> [Pos Char]
loop (LineNo
l forall a. Num a => a -> a -> a
+ LineNo
1) ColumnNo
1 String
xs

      Char
x : String
xs ->
        forall a. Position -> a -> Pos a
Pos (String -> LineNo -> ColumnNo -> Position
Position String
path LineNo
l ColumnNo
c) Char
x forall a. a -> [a] -> [a]
: LineNo -> ColumnNo -> String -> [Pos Char]
loop LineNo
l (ColumnNo
c forall a. Num a => a -> a -> a
+ ColumnNo
1) String
xs
  in
    LineNo -> ColumnNo -> String -> [Pos Char]
loop LineNo
1 ColumnNo
1