{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Df1.Types
( Log(Log, log_time, log_level, log_path, log_message)
, Level(Debug, Info, Notice, Warning, Error, Critical, Alert, Emergency)
, Path(Attr, Push), ToPath(path)
, Segment, unSegment, ToSegment(segment)
, Key, unKey, ToKey(key)
, Value, unValue, ToValue(value)
, Message, unMessage, ToMessage(message)
) where
import Control.Exception (SomeException)
import Data.Coerce (coerce)
import qualified Data.Fixed as Fixed
import Data.Foldable (toList)
import Data.Semigroup (Semigroup((<>)))
import Data.Sequence as Seq
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Word (Word8, Word16, Word32, Word64)
import Numeric.Natural (Natural)
import Data.String (IsString(fromString))
import qualified Data.Time as Time
import qualified Data.Time.Clock.System as Time
import qualified Data.Time.Format.ISO8601 as Time
data Log = Log
{ Log -> SystemTime
log_time :: !Time.SystemTime
, Log -> Level
log_level :: !Level
, Log -> Seq Path
log_path :: !(Seq.Seq Path)
, Log -> Message
log_message :: !Message
} deriving (Log -> Log -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Log -> Log -> Bool
$c/= :: Log -> Log -> Bool
== :: Log -> Log -> Bool
$c== :: Log -> Log -> Bool
Eq, Int -> Log -> ShowS
[Log] -> ShowS
Log -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Log] -> ShowS
$cshowList :: [Log] -> ShowS
show :: Log -> String
$cshow :: Log -> String
showsPrec :: Int -> Log -> ShowS
$cshowsPrec :: Int -> Log -> ShowS
Show)
newtype Message = Message TL.Text
deriving (Message -> Message -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c== :: Message -> Message -> Bool
Eq, Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Message] -> ShowS
$cshowList :: [Message] -> ShowS
show :: Message -> String
$cshow :: Message -> String
showsPrec :: Int -> Message -> ShowS
$cshowsPrec :: Int -> Message -> ShowS
Show)
unMessage :: Message -> TL.Text
unMessage :: Message -> Text
unMessage = coerce :: forall a b. Coercible a b => a -> b
coerce
{-# INLINE unMessage #-}
instance IsString Message where
fromString :: String -> Message
fromString = forall a. ToMessage a => a -> Message
message
{-# INLINE fromString #-}
instance Semigroup Message where
<> :: Message -> Message -> Message
(<>) = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Semigroup a => a -> a -> a
(<>) :: TL.Text -> TL.Text -> TL.Text)
{-# INLINE (<>) #-}
instance Monoid Message where
mempty :: Message
mempty = Text -> Message
Message forall a. Monoid a => a
mempty
{-# INLINE mempty #-}
class ToMessage a where
message :: a -> Message
instance ToMessage Message where
message :: Message -> Message
message = forall a. a -> a
id
{-# INLINE message #-}
instance ToMessage TL.Text where
message :: Text -> Message
message = Text -> Message
Message
{-# INLINE message #-}
instance ToMessage T.Text where
message :: Text -> Message
message = Text -> Message
Message forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict
{-# INLINE message #-}
instance ToMessage String where
message :: String -> Message
message = Text -> Message
Message forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack
{-# INLINE message #-}
instance ToMessage SomeException where
message :: SomeException -> Message
message = forall a. ToMessage a => a -> Message
message forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
{-# INLINE message #-}
data Level
= Debug
| Info
| Notice
| Warning
| Error
| Critical
| Alert
| Emergency
deriving (Level -> Level -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Level -> Level -> Bool
$c/= :: Level -> Level -> Bool
== :: Level -> Level -> Bool
$c== :: Level -> Level -> Bool
Eq, Int -> Level -> ShowS
[Level] -> ShowS
Level -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Level] -> ShowS
$cshowList :: [Level] -> ShowS
show :: Level -> String
$cshow :: Level -> String
showsPrec :: Int -> Level -> ShowS
$cshowsPrec :: Int -> Level -> ShowS
Show, ReadPrec [Level]
ReadPrec Level
Int -> ReadS Level
ReadS [Level]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Level]
$creadListPrec :: ReadPrec [Level]
readPrec :: ReadPrec Level
$creadPrec :: ReadPrec Level
readList :: ReadS [Level]
$creadList :: ReadS [Level]
readsPrec :: Int -> ReadS Level
$creadsPrec :: Int -> ReadS Level
Read, Level
forall a. a -> a -> Bounded a
maxBound :: Level
$cmaxBound :: Level
minBound :: Level
$cminBound :: Level
Bounded, Int -> Level
Level -> Int
Level -> [Level]
Level -> Level
Level -> Level -> [Level]
Level -> Level -> Level -> [Level]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Level -> Level -> Level -> [Level]
$cenumFromThenTo :: Level -> Level -> Level -> [Level]
enumFromTo :: Level -> Level -> [Level]
$cenumFromTo :: Level -> Level -> [Level]
enumFromThen :: Level -> Level -> [Level]
$cenumFromThen :: Level -> Level -> [Level]
enumFrom :: Level -> [Level]
$cenumFrom :: Level -> [Level]
fromEnum :: Level -> Int
$cfromEnum :: Level -> Int
toEnum :: Int -> Level
$ctoEnum :: Int -> Level
pred :: Level -> Level
$cpred :: Level -> Level
succ :: Level -> Level
$csucc :: Level -> Level
Enum)
deriving instance Ord Level
newtype Segment = Segment TL.Text
deriving (Segment -> Segment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Segment -> Segment -> Bool
$c/= :: Segment -> Segment -> Bool
== :: Segment -> Segment -> Bool
$c== :: Segment -> Segment -> Bool
Eq, Int -> Segment -> ShowS
[Segment] -> ShowS
Segment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Segment] -> ShowS
$cshowList :: [Segment] -> ShowS
show :: Segment -> String
$cshow :: Segment -> String
showsPrec :: Int -> Segment -> ShowS
$cshowsPrec :: Int -> Segment -> ShowS
Show)
unSegment :: Segment -> TL.Text
unSegment :: Segment -> Text
unSegment = coerce :: forall a b. Coercible a b => a -> b
coerce
{-# INLINE unSegment #-}
instance IsString Segment where
fromString :: String -> Segment
fromString = forall a. ToSegment a => a -> Segment
segment
{-# INLINE fromString #-}
instance Semigroup Segment where
<> :: Segment -> Segment -> Segment
(<>) = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Semigroup a => a -> a -> a
(<>) :: TL.Text -> TL.Text -> TL.Text)
{-# INLINE (<>) #-}
instance Monoid Segment where
mempty :: Segment
mempty = Text -> Segment
Segment forall a. Monoid a => a
mempty
{-# INLINE mempty #-}
class ToSegment a where
segment :: a -> Segment
instance ToSegment Segment where
segment :: Segment -> Segment
segment = forall a. a -> a
id
{-# INLINE segment #-}
instance ToSegment TL.Text where
segment :: Text -> Segment
segment = Text -> Segment
Segment
{-# INLINE segment #-}
instance ToSegment T.Text where
segment :: Text -> Segment
segment = Text -> Segment
Segment forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict
{-# INLINE segment #-}
instance ToSegment String where
segment :: String -> Segment
segment = Text -> Segment
Segment forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack
{-# INLINE segment #-}
instance ToSegment Char where
segment :: Char -> Segment
segment = Text -> Segment
Segment forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
TL.singleton
{-# INLINE segment #-}
newtype Key = Key TL.Text
deriving (Key -> Key -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq, Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> Key -> ShowS
Show)
unKey :: Key -> TL.Text
unKey :: Key -> Text
unKey = coerce :: forall a b. Coercible a b => a -> b
coerce
{-# INLINE unKey #-}
instance IsString Key where
fromString :: String -> Key
fromString = forall a. ToKey a => a -> Key
key
{-# INLINE fromString #-}
instance Semigroup Key where
<> :: Key -> Key -> Key
(<>) = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Semigroup a => a -> a -> a
(<>) :: TL.Text -> TL.Text -> TL.Text)
{-# INLINE (<>) #-}
instance Monoid Key where
mempty :: Key
mempty = Text -> Key
Key forall a. Monoid a => a
mempty
{-# INLINE mempty #-}
class ToKey a where
key :: a -> Key
instance ToKey Key where
key :: Key -> Key
key = forall a. a -> a
id
{-# INLINE key #-}
instance ToKey TL.Text where
key :: Text -> Key
key = Text -> Key
Key
{-# INLINE key #-}
instance ToKey T.Text where
key :: Text -> Key
key = Text -> Key
Key forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict
{-# INLINE key #-}
instance ToKey String where
key :: String -> Key
key = Text -> Key
Key forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack
{-# INLINE key #-}
instance ToKey Char where
key :: Char -> Key
key = Text -> Key
Key forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
TL.singleton
{-# INLINE key #-}
newtype Value = Value TL.Text
deriving (Value -> Value -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Show)
unValue :: Value -> TL.Text
unValue :: Value -> Text
unValue = coerce :: forall a b. Coercible a b => a -> b
coerce
{-# INLINE unValue #-}
instance IsString Value where
fromString :: String -> Value
fromString = forall a. ToValue a => a -> Value
value
{-# INLINE fromString #-}
instance Semigroup Value where
<> :: Value -> Value -> Value
(<>) = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Semigroup a => a -> a -> a
(<>) :: TL.Text -> TL.Text -> TL.Text)
{-# INLINE (<>) #-}
instance Monoid Value where
mempty :: Value
mempty = Text -> Value
Value forall a. Monoid a => a
mempty
{-# INLINE mempty #-}
class ToValue a where
value :: a -> Value
instance ToValue Value where
value :: Value -> Value
value = forall a. a -> a
id
{-# INLINE value #-}
instance ToValue TL.Text where
value :: Text -> Value
value = Text -> Value
Value
{-# INLINE value #-}
instance ToValue T.Text where
value :: Text -> Value
value = Text -> Value
Value forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict
{-# INLINE value #-}
instance ToValue String where
value :: String -> Value
value = Text -> Value
Value forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack
{-# INLINE value #-}
instance ToValue SomeException where
value :: SomeException -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
{-# INLINE value #-}
instance ToValue Bool where
value :: Bool -> Value
value = \Bool
b -> if Bool
b then Value
"true" else Value
"false"
{-# INLINE value #-}
instance ToValue Char where
value :: Char -> Value
value = Text -> Value
Value forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
TL.singleton
{-# INLINE value #-}
instance ToValue Int where
value :: Int -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
{-# INLINE value #-}
instance ToValue Int8 where
value :: Int8 -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
{-# INLINE value #-}
instance ToValue Int16 where
value :: Int16 -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
{-# INLINE value #-}
instance ToValue Int32 where
value :: Int32 -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
{-# INLINE value #-}
instance ToValue Int64 where
value :: Int64 -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
{-# INLINE value #-}
instance ToValue Word where
value :: Word -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
{-# INLINE value #-}
instance ToValue Word8 where
value :: Word8 -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
{-# INLINE value #-}
instance ToValue Word16 where
value :: Word16 -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
{-# INLINE value #-}
instance ToValue Word32 where
value :: Word32 -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
{-# INLINE value #-}
instance ToValue Word64 where
value :: Word64 -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
{-# INLINE value #-}
instance ToValue Integer where
value :: Integer -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
{-# INLINE value #-}
instance ToValue Natural where
value :: Natural -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
{-# INLINE value #-}
instance ToValue Float where
value :: Float -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
{-# INLINE value #-}
instance ToValue Double where
value :: Double -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
{-# INLINE value #-}
instance Fixed.HasResolution a => ToValue (Fixed.Fixed a) where
value :: Fixed a -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
Fixed.showFixed Bool
True
{-# INLINE value #-}
instance ToValue Time.CalendarDiffDays where
value :: CalendarDiffDays -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. ISO8601 t => t -> String
Time.iso8601Show
{-# INLINE value #-}
instance ToValue Time.CalendarDiffTime where
value :: CalendarDiffTime -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. ISO8601 t => t -> String
Time.iso8601Show
{-# INLINE value #-}
instance ToValue Time.Day where
value :: Day -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. ISO8601 t => t -> String
Time.iso8601Show
{-# INLINE value #-}
instance ToValue Time.TimeZone where
value :: TimeZone -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. ISO8601 t => t -> String
Time.iso8601Show
{-# INLINE value #-}
instance ToValue Time.TimeOfDay where
value :: TimeOfDay -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. ISO8601 t => t -> String
Time.iso8601Show
{-# INLINE value #-}
instance ToValue Time.LocalTime where
value :: LocalTime -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. ISO8601 t => t -> String
Time.iso8601Show
{-# INLINE value #-}
instance ToValue Time.ZonedTime where
value :: ZonedTime -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. ISO8601 t => t -> String
Time.iso8601Show
{-# INLINE value #-}
instance ToValue Time.NominalDiffTime where
value :: NominalDiffTime -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
{-# INLINE value #-}
instance ToValue Time.DiffTime where
value :: DiffTime -> Value
value = forall a. ToValue a => a -> Value
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
{-# INLINE value #-}
instance ToValue Time.DayOfWeek where
value :: DayOfWeek -> Value
value = \DayOfWeek
x -> case DayOfWeek
x of
DayOfWeek
Time.Monday -> Value
"monday"
DayOfWeek
Time.Tuesday -> Value
"tuesday"
DayOfWeek
Time.Wednesday -> Value
"wednesday"
DayOfWeek
Time.Thursday -> Value
"thursday"
DayOfWeek
Time.Friday -> Value
"friday"
DayOfWeek
Time.Saturday -> Value
"saturday"
DayOfWeek
Time.Sunday -> Value
"sunday"
data Path
= Push !Segment
| Attr !Key !Value
deriving (Path -> Path -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c== :: Path -> Path -> Bool
Eq, Int -> Path -> ShowS
[Path] -> ShowS
Path -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Path] -> ShowS
$cshowList :: [Path] -> ShowS
show :: Path -> String
$cshow :: Path -> String
showsPrec :: Int -> Path -> ShowS
$cshowsPrec :: Int -> Path -> ShowS
Show)
class ToPath a where
path :: a -> Seq.Seq Path
instance ToPath (Seq.Seq Path) where
path :: Seq Path -> Seq Path
path = forall a. a -> a
id
{-# INLINE path #-}
instance {-# OVERLAPPABLE #-} Foldable f => ToPath (f Path) where
path :: f Path -> Seq Path
path = forall a. [a] -> Seq a
Seq.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
{-# INLINE path #-}