{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators     #-}

module Poseidon.CLI.Survey where

import           Poseidon.BibFile          (BibTeX)
import           Poseidon.GenotypeData     (GenotypeDataSpec (..),
                                            GenotypeFileSpec (..))
import           Poseidon.Janno            (CsvNamedRecord, GeneticSex,
                                            JannoRows (..), ListColumn (..))
import           Poseidon.Package          (PackageReadOptions (..),
                                            PoseidonPackage (..),
                                            defaultPackageReadOptions,
                                            readPoseidonPackageCollection)
import           Poseidon.Utils            (PoseidonIO, logInfo)

import           Control.Monad             (forM)
import           Control.Monad.IO.Class    (liftIO)
import           Data.List                 (intercalate, unfoldr, zip5)
import           Data.Ratio                (Ratio, (%))
import           Generics.SOP              (All, Generic (Code, from),
                                            HCollapse (hcollapse),
                                            HPure (hpure), I, K (K), NP,
                                            Proxy (..), SListI, hcmap, hzipWith,
                                            unI, unSOP, unZ)
import           Poseidon.SequencingSource (SeqSourceRows (..))
import           System.Directory          (doesFileExist)
import           System.FilePath           ((</>))
import           Text.Layout.Table         (asciiRoundS, column, def,
                                            expandUntil, rowsG, tableString,
                                            titlesH)

-- | A datatype representing command line options for the survey command
data SurveyOptions = SurveyOptions
    { SurveyOptions -> [String]
_surveyBaseDirs   :: [FilePath]
    , SurveyOptions -> Bool
_surveyRawOutput  :: Bool
    , SurveyOptions -> Bool
_surveyOnlyLatest :: Bool
    }

-- | The main function running the janno command
runSurvey :: SurveyOptions -> PoseidonIO ()
runSurvey :: SurveyOptions -> PoseidonIO ()
runSurvey (SurveyOptions [String]
baseDirs Bool
rawOutput Bool
onlyLatest) = do
    let pacReadOpts :: PackageReadOptions
pacReadOpts = PackageReadOptions
defaultPackageReadOptions {
          _readOptIgnoreChecksums :: Bool
_readOptIgnoreChecksums  = Bool
True
        , _readOptIgnoreGeno :: Bool
_readOptIgnoreGeno       = Bool
True
        , _readOptGenoCheck :: Bool
_readOptGenoCheck        = Bool
False
        , _readOptOnlyLatest :: Bool
_readOptOnlyLatest       = Bool
onlyLatest
    }
    [PoseidonPackage]
allPackages <- PackageReadOptions -> [String] -> PoseidonIO [PoseidonPackage]
readPoseidonPackageCollection PackageReadOptions
pacReadOpts [String]
baseDirs
    -- collect information
    let packageNames :: [PacNameAndVersion]
packageNames = (PoseidonPackage -> PacNameAndVersion)
-> [PoseidonPackage] -> [PacNameAndVersion]
forall a b. (a -> b) -> [a] -> [b]
map PoseidonPackage -> PacNameAndVersion
posPacNameAndVersion [PoseidonPackage]
allPackages
    -- geno
    [Bool]
genoTypeDataExists <- [PoseidonPackage]
-> (PoseidonPackage -> ReaderT Env IO Bool)
-> ReaderT Env IO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [PoseidonPackage]
allPackages ((PoseidonPackage -> ReaderT Env IO Bool) -> ReaderT Env IO [Bool])
-> (PoseidonPackage -> ReaderT Env IO Bool)
-> ReaderT Env IO [Bool]
forall a b. (a -> b) -> a -> b
$ \PoseidonPackage
pac -> do
        case GenotypeDataSpec -> GenotypeFileSpec
genotypeFileSpec (GenotypeDataSpec -> GenotypeFileSpec)
-> (PoseidonPackage -> GenotypeDataSpec)
-> PoseidonPackage
-> GenotypeFileSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoseidonPackage -> GenotypeDataSpec
posPacGenotypeData (PoseidonPackage -> GenotypeFileSpec)
-> PoseidonPackage -> GenotypeFileSpec
forall a b. (a -> b) -> a -> b
$ PoseidonPackage
pac of
            GenotypeEigenstrat String
gf Maybe String
_ String
sf Maybe String
_ String
i Maybe String
_ -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> ReaderT Env IO [Bool] -> ReaderT Env IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ReaderT Env IO Bool)
-> [String] -> ReaderT Env IO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (IO Bool -> ReaderT Env IO Bool
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ReaderT Env IO Bool)
-> (String -> IO Bool) -> String -> ReaderT Env IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Bool
doesFileExist (String -> IO Bool) -> (String -> String) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PoseidonPackage -> String
posPacBaseDir PoseidonPackage
pac String -> String -> String
</>)) [String
gf, String
sf, String
i]
            GenotypePlink      String
gf Maybe String
_ String
sf Maybe String
_ String
i Maybe String
_ -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> ReaderT Env IO [Bool] -> ReaderT Env IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ReaderT Env IO Bool)
-> [String] -> ReaderT Env IO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (IO Bool -> ReaderT Env IO Bool
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ReaderT Env IO Bool)
-> (String -> IO Bool) -> String -> ReaderT Env IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Bool
doesFileExist (String -> IO Bool) -> (String -> String) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PoseidonPackage -> String
posPacBaseDir PoseidonPackage
pac String -> String -> String
</>)) [String
gf, String
sf, String
i]
            GenotypeVCF        String
gf Maybe String
_          ->               IO Bool -> ReaderT Env IO Bool
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ReaderT Env IO Bool)
-> (String -> IO Bool) -> String -> ReaderT Env IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Bool
doesFileExist (String -> ReaderT Env IO Bool) -> String -> ReaderT Env IO Bool
forall a b. (a -> b) -> a -> b
$  PoseidonPackage -> String
posPacBaseDir PoseidonPackage
pac String -> String -> String
</>    String
gf
    -- janno
    let jannos :: [JannoRows]
jannos = (PoseidonPackage -> JannoRows) -> [PoseidonPackage] -> [JannoRows]
forall a b. (a -> b) -> [a] -> [b]
map PoseidonPackage -> JannoRows
posPacJanno [PoseidonPackage]
allPackages
    -- ssf
    let ssfs :: [SeqSourceRows]
ssfs = (PoseidonPackage -> SeqSourceRows)
-> [PoseidonPackage] -> [SeqSourceRows]
forall a b. (a -> b) -> [a] -> [b]
map PoseidonPackage -> SeqSourceRows
posPacSeqSource [PoseidonPackage]
allPackages
    -- bib
    let bibs :: [BibTeX]
bibs = (PoseidonPackage -> BibTeX) -> [PoseidonPackage] -> [BibTeX]
forall a b. (a -> b) -> [a] -> [b]
map PoseidonPackage -> BibTeX
posPacBib [PoseidonPackage]
allPackages
    -- print information
    ([String]
tableH, [[String]]
tableB) <- do
        let tableH :: [String]
tableH = [String
"Package", String
"Survey"]
        [[String]]
tableB <- [(PacNameAndVersion, Bool, JannoRows, SeqSourceRows, BibTeX)]
-> ((PacNameAndVersion, Bool, JannoRows, SeqSourceRows, BibTeX)
    -> ReaderT Env IO [String])
-> ReaderT Env IO [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([PacNameAndVersion]
-> [Bool]
-> [JannoRows]
-> [SeqSourceRows]
-> [BibTeX]
-> [(PacNameAndVersion, Bool, JannoRows, SeqSourceRows, BibTeX)]
forall a b c d e.
[a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)]
zip5 [PacNameAndVersion]
packageNames [Bool]
genoTypeDataExists [JannoRows]
jannos [SeqSourceRows]
ssfs [BibTeX]
bibs) (((PacNameAndVersion, Bool, JannoRows, SeqSourceRows, BibTeX)
  -> ReaderT Env IO [String])
 -> ReaderT Env IO [[String]])
-> ((PacNameAndVersion, Bool, JannoRows, SeqSourceRows, BibTeX)
    -> ReaderT Env IO [String])
-> ReaderT Env IO [[String]]
forall a b. (a -> b) -> a -> b
$ \(PacNameAndVersion
p, Bool
g, JannoRows
j, SeqSourceRows
s, BibTeX
b) -> do
            [String] -> ReaderT Env IO [String]
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [PacNameAndVersion -> String
forall a. Show a => a -> String
show PacNameAndVersion
p, Bool -> JannoRows -> SeqSourceRows -> BibTeX -> String
renderPackageWithCompleteness Bool
g JannoRows
j SeqSourceRows
s BibTeX
b]
        ([String], [[String]]) -> ReaderT Env IO ([String], [[String]])
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
tableH, [[String]]
tableB)
    let colSpecs :: [ColSpec]
colSpecs = Int -> ColSpec -> [ColSpec]
forall a. Int -> a -> [a]
replicate Int
2 (LenSpec -> Position H -> AlignSpec -> CutMark -> ColSpec
column (Int -> LenSpec
expandUntil Int
60) Position H
forall a. Default a => a
def AlignSpec
forall a. Default a => a
def CutMark
forall a. Default a => a
def)
    if Bool
rawOutput
    then IO () -> PoseidonIO ()
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PoseidonIO ()) -> IO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" [String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\t" [String]
row | [String]
row <- [[String]]
tableB]
    else IO () -> PoseidonIO ()
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PoseidonIO ()) -> IO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [ColSpec]
-> TableStyle -> HeaderSpec -> [RowGroup String] -> String
forall a.
Cell a =>
[ColSpec] -> TableStyle -> HeaderSpec -> [RowGroup a] -> String
tableString [ColSpec]
colSpecs TableStyle
asciiRoundS ([String] -> HeaderSpec
titlesH [String]
tableH) [[[String]] -> RowGroup String
forall a. [Row a] -> RowGroup a
rowsG [[String]]
tableB]
    -- print help
    String -> PoseidonIO ()
logInfo String
"see trident survey -h for a list of column names"

renderPackageWithCompleteness :: Bool -> JannoRows -> SeqSourceRows -> BibTeX -> String
renderPackageWithCompleteness :: Bool -> JannoRows -> SeqSourceRows -> BibTeX -> String
renderPackageWithCompleteness Bool
genoTypeDataExists JannoRows
janno (SeqSourceRows [SeqSourceRow]
seqSource) BibTeX
bib =
       (if Bool
genoTypeDataExists then String
"G" else String
".")
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if Bool -> Bool
not ([SeqSourceRow] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SeqSourceRow]
seqSource) then String
"S" else String
".")
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if Bool -> Bool
not (BibTeX -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null BibTeX
bib) then String
"B" else String
".")
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|"
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String -> String
forall a. Int -> a -> [a] -> [a]
insertEveryN Int
5 Char
'|' (JannoRows -> String
renderJannoCompleteness JannoRows
janno)
    where
        -- https://stackoverflow.com/questions/12659562/insert-specific-element-y-after-every-n-elements-in-a-list
        insertEveryN :: Int -> a -> [a] -> [a]
        insertEveryN :: forall a. Int -> a -> [a] -> [a]
insertEveryN Int
n a
y [a]
xs = [a] -> [[a]] -> [a]
forall a. [a] -> [[a]] -> [a]
intercalate [a
y] ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [[a]]
forall {a}. Int -> [a] -> [[a]]
groups Int
n ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a]
xs
            where groups :: Int -> [a] -> [[a]]
groups Int
n_ [a]
xs_ = ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Maybe ([a], [a])) -> [a] -> [[a]]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (([a], [a]) -> Maybe ([a], [a])
forall a. a -> Maybe a
Just (([a], [a]) -> Maybe ([a], [a]))
-> ([a] -> ([a], [a])) -> [a] -> Maybe ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n_) ([a] -> [[a]]) -> [a] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [a]
xs_

renderJannoCompleteness :: JannoRows -> String
renderJannoCompleteness :: JannoRows -> String
renderJannoCompleteness (JannoRows [JannoRow]
rows) =
    let ratioString :: String
ratioString = (Ratio Int -> Char) -> [Ratio Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map Ratio Int -> Char
prop2Char ([Ratio Int] -> String) -> [Ratio Int] -> String
forall a b. (a -> b) -> a -> b
$ [JannoRow] -> [Ratio Int]
forall a (xs :: [*]).
(Generic a, Code a ~ '[xs], All PresenceCountable xs) =>
[a] -> [Ratio Int]
getRatiosForEachField [JannoRow]
rows
    in String -> String
forall a. HasCallStack => [a] -> [a]
init String
ratioString -- remove last entry covering the additional columns (CsvNamedRecord)
    where
        -- the following magic was heavily inspired by https://stackoverflow.com/a/41524511/3216883
        getRatiosForEachField :: (Generics.SOP.Generic a, Code a ~ '[ xs ], All PresenceCountable xs) => [a] -> [Ratio Int]
        getRatiosForEachField :: forall a (xs :: [*]).
(Generic a, Code a ~ '[xs], All PresenceCountable xs) =>
[a] -> [Ratio Int]
getRatiosForEachField =
            NP (K (Ratio Int)) xs -> [Ratio Int]
NP (K (Ratio Int)) xs -> CollapseTo NP (Ratio Int)
forall (xs :: [*]) a.
SListIN NP xs =>
NP (K a) xs -> CollapseTo NP a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
          (NP (K (Ratio Int)) xs -> [Ratio Int])
-> ([a] -> NP (K (Ratio Int)) xs) -> [a] -> [Ratio Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy PresenceCountable
-> (forall a. PresenceCountable a => [a] -> K (Ratio Int) a)
-> NP [] xs
-> NP (K (Ratio Int)) xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (Proxy PresenceCountable
forall {k} (t :: k). Proxy t
Proxy :: Proxy PresenceCountable) (Ratio Int -> K (Ratio Int) a
forall k a (b :: k). a -> K a b
K (Ratio Int -> K (Ratio Int) a)
-> ([a] -> Ratio Int) -> [a] -> K (Ratio Int) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Ratio Int
forall a. PresenceCountable a => [a] -> Ratio Int
measureFillState)
          (NP [] xs -> NP (K (Ratio Int)) xs)
-> ([a] -> NP [] xs) -> [a] -> NP (K (Ratio Int)) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NP I xs] -> NP [] xs
forall (xs :: [*]). SListI xs => [NP I xs] -> NP [] xs
hunzip
          ([NP I xs] -> NP [] xs) -> ([a] -> [NP I xs]) -> [a] -> NP [] xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> NP I xs) -> [a] -> [NP I xs]
forall a b. (a -> b) -> [a] -> [b]
map (NS (NP I) '[xs] -> NP I xs
forall {k} (f :: k -> *) (x :: k). NS f '[x] -> f x
unZ (NS (NP I) '[xs] -> NP I xs)
-> (a -> NS (NP I) '[xs]) -> a -> NP I xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SOP I '[xs] -> NS (NP I) '[xs]
forall {k} (f :: k -> *) (xss :: [[k]]). SOP f xss -> NS (NP f) xss
unSOP (SOP I '[xs] -> NS (NP I) '[xs])
-> (a -> SOP I '[xs]) -> a -> NS (NP I) '[xs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SOP I '[xs]
a -> Rep a
forall a. Generic a => a -> Rep a
from)
        hunzip :: SListI xs => [NP I xs] -> NP [] xs
        hunzip :: forall (xs :: [*]). SListI xs => [NP I xs] -> NP [] xs
hunzip = (NP I xs -> NP [] xs -> NP [] xs)
-> NP [] xs -> [NP I xs] -> NP [] xs
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((forall a. I a -> [a] -> [a])
-> Prod NP I xs -> NP [] xs -> NP [] xs
forall {k} {l} (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *).
(SListIN (Prod h) xs, HAp h, HAp (Prod h)) =>
(forall (a :: k). f a -> f' a -> f'' a)
-> Prod h f xs -> h f' xs -> h f'' xs
hzipWith ((:) (a -> [a] -> [a]) -> (I a -> a) -> I a -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. I a -> a
forall a. I a -> a
unI)) ((forall a. [a]) -> NP [] xs
forall (xs :: [*]) (f :: * -> *).
SListIN NP xs =>
(forall a. f a) -> NP f xs
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *).
(HPure h, SListIN h xs) =>
(forall (a :: k). f a) -> h f xs
hpure [])
        measureFillState :: PresenceCountable a => [a] -> Ratio Int
        measureFillState :: forall a. PresenceCountable a => [a] -> Ratio Int
measureFillState [a]
vals =
            let nrValues :: Int
nrValues = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
vals
                nrFilledValues :: Int
nrFilledValues = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (a -> Int) -> [a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map a -> Int
forall a. PresenceCountable a => a -> Int
countPresence [a]
vals
            in Int
nrFilledValues Int -> Int -> Ratio Int
forall a. Integral a => a -> a -> Ratio a
% Int
nrValues
        prop2Char :: Ratio Int -> Char
        prop2Char :: Ratio Int -> Char
prop2Char Ratio Int
r
            | Ratio Int
r Ratio Int -> Ratio Int -> Bool
forall a. Eq a => a -> a -> Bool
== Ratio Int
0    = Char
'.'
            | Ratio Int
r Ratio Int -> Ratio Int -> Bool
forall a. Ord a => a -> a -> Bool
< Ratio Int
0.25  = Char
'░'
            | Ratio Int
r Ratio Int -> Ratio Int -> Bool
forall a. Ord a => a -> a -> Bool
< Ratio Int
0.5   = Char
'▒'
            | Ratio Int
r Ratio Int -> Ratio Int -> Bool
forall a. Ord a => a -> a -> Bool
< Ratio Int
1     = Char
'▓'
            | Ratio Int
r Ratio Int -> Ratio Int -> Bool
forall a. Eq a => a -> a -> Bool
== Ratio Int
1    = Char
'█'
            | Bool
otherwise = Char
'?'

-- A typeclass to determine if a field in a .janno row is filled
class PresenceCountable a where
    countPresence :: a -> Int
instance PresenceCountable (Maybe a) where
    countPresence :: Maybe a -> Int
countPresence Maybe a
Nothing  = Int
0
    countPresence (Just a
_) = Int
1
instance PresenceCountable String where
    countPresence :: String -> Int
countPresence String
_ = Int
1
instance PresenceCountable GeneticSex where
    countPresence :: GeneticSex -> Int
countPresence GeneticSex
_ = Int
1
instance PresenceCountable (ListColumn a) where
    countPresence :: ListColumn a -> Int
countPresence ListColumn a
_ = Int
1
instance PresenceCountable CsvNamedRecord where
    countPresence :: CsvNamedRecord -> Int
countPresence CsvNamedRecord
_ = Int
0